Chapter 35 — Approximation Algorithms
CLRS, fourth edition · Lean 4 formalization
The proofs below use the models and assumptions described in the scope and implementation notes.
Imports
import Mathlib35.1. The Vertex-Cover Problem
This section formalizes the vertex-cover problem and the 2-approximation
guarantee of the APPROX-VERTEX-COVER algorithm from CLRS §35.1. A vertex
cover of an undirected graph G = (V, E) is a set of vertices C ⊆ V that
meets every edge: for every edge (u, v) ∈ E, at least one of u, v lies in
C. The minimum vertex cover is the smallest such set. Computing a minimum
vertex cover is NP-hard, but the greedy APPROX-VERTEX-COVER algorithm always
finds a cover within a factor of two of the optimum.
Main results:
-
Definition
Graph: an edge-based graph model — an edge type with source and destination maps into the vertex type. -
Definition
IsVertexCoverOn: a set of vertices meeting every edge of an edge set. -
Definition
IsMatching: a set of pairwise non-incident edges. -
Definition
IsMaximalMatchingOn: a matching that meets every edge. -
Definition
approxVertexCoverEdges: the greedy edge-selection loop of APPROX-VERTEX-COVER. -
Definition
approxVertexCover: the cover returned by APPROX-VERTEX-COVER (the endpoints of the selected edges). -
Theorem
approxVertexCoverEdges_maximal: the greedy loop returns a maximal matching. -
Theorem
endpoints_isVertexCover: the endpoints of a maximal matching form a vertex cover. -
Theorem
matching_le_cover(Lemma 35.1): any vertex cover has size at least that of any matching. -
Theorem
endpoints_card: a matching on a loop-free graph contributes exactly two distinct vertices per edge. -
Theorem
approxVertexCover_isVertexCover(Theorem 35.1): APPROX-VERTEX-COVER returns a vertex cover. -
Theorem
approxVertexCover_two_approx(Theorem 35.1): the returned cover has size at most twice that of any vertex cover — in particular, of an optimal one.
Notation conventions used in this section:
-
G: a graph (an edge type withsrc/dstendpoint maps) -
V: the vertex type -
E: the edge type -
E₀: the finite set of edges of the graph -
C: a candidate vertex cover -
A: a set of edges selected by the greedy algorithm -
Cstar: an optimal vertex cover
noncomputable sectionnamespace CLRSnamespace ApproxVertexCovervariable {V E : Type} [DecidableEq V] [DecidableEq E]
An edge-based graph: a type E of edges together with source and
destination maps into the vertex type V. This is the minimal structure
needed to state vertex covers, matchings, and the greedy algorithm, and matches
the edge model used elsewhere in the repository (cf. the minimum-spanning-tree
sections).
structure Graph (V E : Type) where
src : E → V
dst : E → Vnamespace Graphvariable (G : Graph V E)A vertex is incident to an edge when it is one of the edge's endpoints.
Two edges are incident when they share at least one endpoint.
A vertex cover of the edge set E₀: a set of vertices C meeting every
edge of E₀. For the CLRS graph G = (V, E) the edge set is the whole graph
(E₀ = E), so every edge has an endpoint in C (CLRS §35.1).
def IsVertexCoverOn (E₀ : Finset E) (C : Finset V) : Prop :=
∀ e : E, e ∈ E₀ → G.src e ∈ C ∨ G.dst e ∈ CA matching: a set of edges no two of which share an endpoint (CLRS §35.1).
def IsMatching (A : Finset E) : Prop :=
∀ ⦃e f : E⦄, e ∈ A → f ∈ A → e ≠ f → ¬ G.EdgesIncident e f
A maximal matching of the edge set E₀: a matching that meets every edge
of E₀ — no further edge of E₀ can be added without sharing an endpoint.
def IsMaximalMatchingOn (E₀ : Finset E) (A : Finset E) : Prop :=
G.IsMatching A ∧ ∀ e : E, e ∈ E₀ → ∃ f ∈ A, G.EdgesIncident e f
The set of vertices incident to at least one edge of A: the endpoints of the
edges in A.
An edge is incident to itself (its source is a common endpoint).
theorem edgesIncident_self (e : E) : G.EdgesIncident e e :=
⟨G.src e, Or.inl rfl, Or.inl rfl⟩
Edge incidence is symmetric: if e and f share an endpoint, so do f
and e.
theorem edgesIncident_symm {e f : E} (h : G.EdgesIncident e f) : G.EdgesIncident f e := by
rcases h with ⟨v, hve, hvf⟩
exact ⟨v, hvf, hve⟩
The edges of E₀ that are not incident to e: the remainder of the edge
set after a greedy step deletes every edge sharing an endpoint with the picked
edge e.
def incidentFiltered (E₀ : Finset E) (e : E) : Finset E := by
classical
exact E₀.filter (fun f => ¬ G.EdgesIncident e f)Deleting the edges incident to the picked edge strictly shrinks a nonempty edge set, because the picked edge itself is deleted.
lemma filter_incident_card_lt (E₀ : Finset E) (hne : E₀.Nonempty) :
(G.incidentFiltered E₀ hne.choose).card < E₀.card := by
classical
have henot : hne.choose ∉ G.incidentFiltered E₀ hne.choose := by
intro hm
unfold incidentFiltered at hm
exact (Finset.mem_filter.mp hm).2 (G.edgesIncident_self hne.choose)
have hsub : G.incidentFiltered E₀ hne.choose ⊆ E₀ := by
intro f hf
unfold incidentFiltered at hf
exact (Finset.mem_filter.mp hf).1
exact Finset.card_lt_card ⟨hsub, by
intro hEq
exact henot (hEq hne.choose_spec)⟩The greedy edge-selection loop of APPROX-VERTEX-COVER: while edges remain, pick an arbitrary edge, add it to the chosen set, and delete every edge sharing an endpoint with it. This returns the chosen edges; the cover they induce is their endpoints. Each recursive call removes the picked edge, so the remaining edge set strictly shrinks and the loop terminates (CLRS §35.1, APPROX-VERTEX-COVER).
noncomputable def approxVertexCoverEdges (G : Graph V E) : (E₀ : Finset E) → Finset E := by
classical
exact fun E₀ =>
if hne : E₀.Nonempty then
insert hne.choose (approxVertexCoverEdges G (G.incidentFiltered E₀ hne.choose))
else ∅
termination_by E₀ => E₀.card
decreasing_by
classical
exact G.filter_incident_card_lt E₀ hneThe invariants of the greedy loop: the chosen edges form a matching, they meet every edge of the input (maximality), and they are drawn from the input. This is proved by well-founded induction on the size of the remaining edge set, which decreases at every step.
lemma approxVertexCoverEdges_invariants (E₀ : Finset E) :
G.IsMatching (approxVertexCoverEdges G E₀) ∧
(∀ e : E, e ∈ E₀ → ∃ f ∈ approxVertexCoverEdges G E₀, G.EdgesIncident e f) ∧
approxVertexCoverEdges G E₀ ⊆ E₀ := by
classical
let P : Finset E → Prop := fun s =>
G.IsMatching (approxVertexCoverEdges G s) ∧
(∀ e : E, e ∈ s → ∃ f ∈ approxVertexCoverEdges G s, G.EdgesIncident e f) ∧
approxVertexCoverEdges G s ⊆ s
have hwf : WellFounded (fun a b : Finset E => a.card < b.card) :=
(measure (fun s : Finset E => s.card)).wf
have hmain : ∀ s : Finset E, P s := by
refine hwf.fix (C := P) ?_
intro s ih
by_cases hne : s.Nonempty
· unfold P
rw [approxVertexCoverEdges.eq_1, dif_pos hne]
let F : Finset E := G.incidentFiltered s hne.choose
have hFcard : F.card < s.card := by simpa [F] using G.filter_incident_card_lt s hne
have ihF : P F := ih F hFcard
rcases ihF with ⟨hmF, hmaxF, hsubF⟩
have he_mem : hne.choose ∈ s := hne.choose_spec
constructor
· intro e f he hf hnef
rw [Finset.mem_insert] at he hf
rcases he with he_eq | he_memR
· subst e
rcases hf with hf_eq | hf_memR
· subst f
exact False.elim (hnef rfl)
· have hfF : f ∈ F := hsubF hf_memR
simp [F, incidentFiltered] at hfF
exact hfF.2
· rcases hf with hf_eq | hf_memR
· subst f
have heF : e ∈ F := hsubF he_memR
simp [F, incidentFiltered] at heF
exact fun h => heF.2 (G.edgesIncident_symm h)
· exact hmF he_memR hf_memR hnef
· constructor
· intro e he_mem
by_cases hinc : G.EdgesIncident hne.choose e
· exact ⟨hne.choose, Finset.mem_insert.mpr (Or.inl rfl), G.edgesIncident_symm hinc⟩
· have heF : e ∈ F := by
simp [F, incidentFiltered]
exact ⟨he_mem, hinc⟩
rcases hmaxF e heF with ⟨f, hfR, hinc'⟩
exact ⟨f, Finset.mem_insert.mpr (Or.inr hfR), hinc'⟩
· intro a ha
rw [Finset.mem_insert] at ha
rcases ha with ha_eq | ha_memR
· exact ha_eq.symm ▸ he_mem
· have haF : a ∈ F := hsubF ha_memR
simp [F, incidentFiltered] at haF
exact haF.1
· have hs : s = ∅ := by
apply Finset.eq_empty_iff_forall_notMem.mpr
intro a ha
exact hne ⟨a, ha⟩
rw [hs]
unfold P
rw [approxVertexCoverEdges.eq_1]
simp [IsMatching]
exact hmain E₀The chosen edges of APPROX-VERTEX-COVER form a matching.
theorem approxVertexCoverEdges_matching (E₀ : Finset E) :
G.IsMatching (approxVertexCoverEdges G E₀) :=
(G.approxVertexCoverEdges_invariants E₀).1The chosen edges of APPROX-VERTEX-COVER form a maximal matching of the input edge set: every edge shares an endpoint with some chosen edge.
theorem approxVertexCoverEdges_maximal (E₀ : Finset E) :
G.IsMaximalMatchingOn E₀ (approxVertexCoverEdges G E₀) :=
⟨G.approxVertexCoverEdges_matching E₀, (G.approxVertexCoverEdges_invariants E₀).2.1⟩APPROX-VERTEX-COVER only selects edges from the input edge set.
theorem approxVertexCoverEdges_subset (E₀ : Finset E) :
approxVertexCoverEdges G E₀ ⊆ E₀ :=
(G.approxVertexCoverEdges_invariants E₀).2.2
The endpoints of a maximal matching form a vertex cover: every edge of E₀
shares an endpoint with some matched edge, and that shared endpoint is an
endpoint of the cover.
theorem endpoints_isVertexCover (E₀ : Finset E) (A : Finset E)
(hmax : G.IsMaximalMatchingOn E₀ A) :
G.IsVertexCoverOn E₀ (G.endpoints A) := by
rcases hmax with ⟨hm, hmaxe⟩
intro e he
rcases hmaxe e he with ⟨f, hfA, hinc⟩
rcases hinc with ⟨v, hve, hvf⟩
rcases hve with hve_src | hve_dst
· left
rw [hve_src]
rcases hvf with hvf_src | hvf_dst
· exact Finset.mem_union.mpr (Or.inl (Finset.mem_image.mpr ⟨f, hfA, hvf_src⟩))
· exact Finset.mem_union.mpr (Or.inr (Finset.mem_image.mpr ⟨f, hfA, hvf_dst⟩))
· right
rw [hve_dst]
rcases hvf with hvf_src | hvf_dst
· exact Finset.mem_union.mpr (Or.inl (Finset.mem_image.mpr ⟨f, hfA, hvf_src⟩))
· exact Finset.mem_union.mpr (Or.inr (Finset.mem_image.mpr ⟨f, hfA, hvf_dst⟩))A chosen endpoint of an edge lying in the cover.
def coverEndpoint (C : Finset V) (e : E) (heC : G.src e ∈ C ∨ G.dst e ∈ C) : V :=
if h : G.src e ∈ C then G.src e else G.dst eThe chosen endpoint of an edge indeed lies in the cover.
lemma coverEndpoint_mem {C : Finset V} {e : E} (heC : G.src e ∈ C ∨ G.dst e ∈ C) :
G.coverEndpoint C e heC ∈ C := by
unfold coverEndpoint
by_cases h : G.src e ∈ C
· simpa [h]
· simpa [h] using heC.resolve_left hThe chosen endpoint of an edge is one of the edge's endpoints.
lemma coverEndpoint_incident {C : Finset V} {e : E} (heC : G.src e ∈ C ∨ G.dst e ∈ C) :
G.Incident (G.coverEndpoint C e heC) e := by
unfold coverEndpoint Incident
by_cases h : G.src e ∈ C
· simpa [h]
· simpa [h]Distinct edges of a matching choose distinct endpoints in a cover: if the chosen endpoints coincided, a single vertex would be an endpoint of both edges, contradicting that the edge set is a matching.
lemma coverEndpoint_ne {A : Finset E} {C : Finset V}
(hA : G.IsMatching A) {e f : E} (he : e ∈ A) (hf : f ∈ A) (hnef : e ≠ f)
{se : G.src e ∈ C ∨ G.dst e ∈ C} {sf : G.src f ∈ C ∨ G.dst f ∈ C} :
G.coverEndpoint C e se ≠ G.coverEndpoint C f sf := by
intro hEq
have hend_e : G.Incident (G.coverEndpoint C e se) e := G.coverEndpoint_incident se
have hend_f : G.Incident (G.coverEndpoint C f sf) f := G.coverEndpoint_incident sf
have hinc : G.EdgesIncident e f :=
⟨G.coverEndpoint C e se, hend_e, by simpa [hEq] using hend_f⟩
exact hA he hf hnef hinc
Lemma 35.1 (lower bound). Any vertex cover C of the edge set E₀ has
size at least any matching A contained in E₀: A.card ≤ C.card. Each edge
of A contributes a distinct vertex of C (a single vertex cannot cover two
distinct edges of a matching), so the chosen-endpoint map is injective.
theorem matching_le_cover {E₀ : Finset E} {A : Finset E} {C : Finset V}
(hA : G.IsMatching A) (hAsub : A ⊆ E₀) (hC : G.IsVertexCoverOn E₀ C) :
A.card ≤ C.card := by
let f : {e // e ∈ A} → {v // v ∈ C} :=
fun ⟨e, he⟩ => ⟨G.coverEndpoint C e (hC e (hAsub he)), G.coverEndpoint_mem (hC e (hAsub he))⟩
have hf_inj : Function.Injective f := by
intro ⟨e, he⟩ ⟨f, hf⟩ hEq
have hef : e = f := by
by_contra hne
have hne' : G.coverEndpoint C e (hC e (hAsub he)) ≠
G.coverEndpoint C f (hC f (hAsub hf)) :=
G.coverEndpoint_ne hA he hf hne (se := hC e (hAsub he)) (sf := hC f (hAsub hf))
apply hne'
exact congrArg Subtype.val hEq
exact Subtype.ext hef
have hcard : Fintype.card {e // e ∈ A} ≤ Fintype.card {v // v ∈ C} :=
Fintype.card_le_of_injective f hf_inj
simpa using hcard
On a loop-free graph, a matching A contributes exactly two distinct vertices
per edge, so its endpoint set has size 2 * A.card. This is the counting step
that turns the matching lower bound into the factor-two approximation.
theorem endpoints_card {A : Finset E}
(hA : G.IsMatching A) (hloop : ∀ e : E, G.src e ≠ G.dst e) :
(G.endpoints A).card = 2 * A.card := by
have hcard_src : (A.image G.src).card = A.card := by
refine Finset.card_image_of_injOn ?_
intro a ha b hb hab
by_contra hne
have hinc : G.EdgesIncident a b :=
⟨G.src a, Or.inl rfl, Or.inl hab.symm⟩
exact hA ha hb hne hinc
have hcard_dst : (A.image G.dst).card = A.card := by
refine Finset.card_image_of_injOn ?_
intro a ha b hb hab
by_contra hne
have hinc : G.EdgesIncident a b :=
⟨G.dst a, Or.inr rfl, Or.inr hab.symm⟩
exact hA ha hb hne hinc
have hdisj : Disjoint (A.image G.src) (A.image G.dst) := by
rw [Finset.disjoint_left]
intro v hvsrc hvdst
rcases Finset.mem_image.mp hvsrc with ⟨e, heA, hsrc⟩
rcases Finset.mem_image.mp hvdst with ⟨f, hfA, hdst⟩
have heq : G.src e = G.dst f := by rw [hsrc, hdst]
by_cases hef : e = f
· exact False.elim (hloop e (by simpa [hef] using heq))
· exact hA heA hfA hef ⟨v, Or.inl hsrc, Or.inr hdst⟩
calc
(G.endpoints A).card = ((A.image G.src) ∪ (A.image G.dst)).card := rfl
_ = (A.image G.src).card + (A.image G.dst).card := by
rw [Finset.card_union_of_disjoint hdisj]
_ = A.card + A.card := by rw [hcard_src, hcard_dst]
_ = 2 * A.card := by omegaThe cover returned by APPROX-VERTEX-COVER: the endpoints of the edges chosen by the greedy loop.
def approxVertexCover (E₀ : Finset E) : Finset V :=
G.endpoints (G.approxVertexCoverEdges E₀)Theorem 35.1 (correctness). APPROX-VERTEX-COVER returns a vertex cover of its input edge set: every edge shares an endpoint with a chosen edge, and the chosen edges' endpoints form the returned cover.
theorem approxVertexCover_isVertexCover (E₀ : Finset E) :
G.IsVertexCoverOn E₀ (G.approxVertexCover E₀) := by
unfold approxVertexCover
exact G.endpoints_isVertexCover E₀ (approxVertexCoverEdges G E₀)
(G.approxVertexCoverEdges_maximal E₀)
Theorem 35.1 (2-approximation). For every vertex cover Cstar of the
input edge set — in particular for an optimal one — the cover returned by
APPROX-VERTEX-COVER has size at most twice Cstar.card. The chosen edges form
a matching A with 2 * A.card endpoints, while any cover needs at least
A.card vertices, so the returned cover has size 2 * A.card ≤ 2 * Cstar.card.
theorem approxVertexCover_two_approx (E₀ : Finset E) (Cstar : Finset V)
(hCstar : G.IsVertexCoverOn E₀ Cstar) (hloop : ∀ e : E, G.src e ≠ G.dst e) :
(G.approxVertexCover E₀).card ≤ 2 * Cstar.card := by
let A := approxVertexCoverEdges G E₀
have hA_matching : G.IsMatching A := by simpa [A] using G.approxVertexCoverEdges_matching E₀
have hA_sub : A ⊆ E₀ := by simpa [A] using G.approxVertexCoverEdges_subset E₀
have hA_le : A.card ≤ Cstar.card := G.matching_le_cover hA_matching hA_sub hCstar
have hcard : (G.endpoints A).card = 2 * A.card := G.endpoints_card hA_matching hloop
calc
(G.endpoints A).card = 2 * A.card := hcard
_ ≤ 2 * Cstar.card := by omegaend Graphend ApproxVertexCoverend CLRSImports
import Mathlib35.2. The Traveling-Salesperson Problem
The complete-graph execution constructs the graph, executes Prim's algorithm, and roots the selected tree.
This section formalizes the traveling-salesperson problem and the factor-two
approximation algorithm APPROX-TSP-TOUR from CLRS §35.2. Given a complete
undirected graph on a vertex set V with a nonnegative weight function w
satisfying the triangle inequality, a tour is a Hamiltonian cycle — a cyclic
permutation visiting every vertex exactly once — and the problem is to find a
tour of minimum total weight. Computing an optimal tour is NP-hard, but
APPROX-TSP-TOUR always finds a tour within a factor of two of the optimum by
building a minimum spanning tree, walking it depth-first, and shortcutting the
walk to a cycle.
We model the MST as a rooted tree given by a total parent map p : V → V with
root r (every vertex reaches r by iterating p), matching the total-function
convention of the repository. A tour is a cyclic permutation σ : V → V (a
bijection whose iterates reach every vertex).
Main results:
-
Definition
TreeOn: a rooted tree as a parent map together with its root. -
Definition
treeCost: the total weight of a rooted tree's edges. -
Definition
IsMinimumSpanningTreeOn: a rooted tree of minimum cost. -
Definition
Tour: a tour as a cyclic permutation of the vertices. -
Definition
TourCost: the total weight of a tour. -
Definition
subtree,children,subtreeCost: the tree substructure used by the depth-first walk. -
Definition
dfsWalk: the depth-first walk of a rooted tree, which traverses every tree edge exactly twice. -
Definition
dfsTour: the preorder (depth-first) ordering of the vertices. -
Lemma
mst_le_tour(Lemma 35.3): a minimum spanning tree costs no more than any tour, because deleting one edge from a tour leaves a spanning tree. -
Lemma
dfsWalk_cost(Lemma 35.2): the depth-first walk of a rooted tree has cost exactly twice the tree's cost. -
Lemma
dfsTour_bound: the tour obtained by shortcutting the depth-first walk costs no more than the walk itself (triangle inequality). -
Lemma
dfsTour_isTour: the depth-first ordering of a spanning tree visits every vertex exactly once, so it is a tour. -
Theorem
tsp_two_approx(Theorem 35.2): APPROX-TSP-TOUR returns a tour of cost at most twice the cost of any tour — in particular, of an optimal one.
Notation conventions used in this section:
-
V: the vertex type -
w: a weight functionV → V → Naton the complete graph -
p: a parent map (total function) giving a rooted tree -
r: the root of a rooted tree -
σ: a tour, a cyclic permutation of the vertices -
v₀: the vertex whose tour edge is deleted to obtain a spanning tree -
c: a child ofv(a vertex withp c = vandc ≠ r)
noncomputable sectionnamespace CLRSnamespace TSPvariable {V : Type} [DecidableEq V] [Fintype V]
A weighted complete graph on the vertex type V: a weight for every
(ordered) pair of vertices. This is the CLRS §35.2 model, where the underlying
graph is complete and only the weight function is specified. We use Nat
weights (as in the repository's minimum-spanning-tree sections); the triangle
inequality and the vanishing of loop weights are hypotheses of the theorems
that need them.
abbrev Graph (V : Type) := V → V → Nat
The cost of the path through the vertex list π: the sum of the weights of
consecutive pairs.
def pathCost (w : Graph V) : List V → Nat
| [] => 0
| [_] => 0
| a :: b :: rest => w a b + pathCost w (b :: rest)
The cost of the walk given by the vertex list π. Synonymous with
pathCost; kept as a separate name because the depth-first walk is the primary
object of study here.
The cost of the tour obtained by traversing the path π and then returning
from its last vertex to target. For a Hamiltonian path π of the whole
vertex set with target equal to π's first vertex, this is the cost of the
corresponding Hamiltonian cycle.
def tourCostTo (w : Graph V) (target : V) (π : List V) : Nat :=
pathCost w π + (if h : π = [] then 0 else w (π.getLast h) target)
getLast is proof-irrelevant: the last element of a nonempty list does not
depend on the nonemptiness proof.
lemma getLast_irrel {l : List V} (h1 : l ≠ []) (h2 : l ≠ []) : l.getLast h1 = l.getLast h2 := by
cases l with
| nil => simp at h1
| cons a t =>
cases t with
| nil => rfl
| cons b t' => rfl
The last element of a :: l is the last element of l (any proof works).
lemma getLast_cons_any {a : V} {l : List V} (h : l ≠ []) (h' : a :: l ≠ []) :
(a :: l).getLast h' = l.getLast h := by
cases l with
| nil => simp at h
| cons b t =>
cases t with
| nil => rfl
| cons c t' => rfl
The last element of l₁ ++ l₂ (both nonempty) is the last element of l₂.
lemma getLast_append_of_right_ne_nil' (l1 l2 : List V) (hne : l1 ++ l2 ≠ []) (h2 : l2 ≠ []) :
(l1 ++ l2).getLast hne = l2.getLast h2 := by
induction l1 with
| nil => rfl
| cons a t ih =>
by_cases htl : t ++ l2 = []
· have ht : t = [] := by simpa using (List.append_eq_nil_iff.mp htl).1
have hl2 : l2 = [] := by simpa using (List.append_eq_nil_iff.mp htl).2
subst ht
subst hl2
simp at h2
· change (a :: (t ++ l2)).getLast hne = l2.getLast h2
have hcons : (a :: (t ++ l2)).getLast hne = (t ++ l2).getLast htl :=
getLast_cons_any htl hne
rw [hcons]
exact ih htl
The last element of l ++ [a] is a.
lemma getLast_append_singleton' {a : V} (l : List V) (h : l ++ [a] ≠ []) :
(l ++ [a]).getLast h = a := by
induction l with
| nil => rfl
| cons b t ih =>
by_cases htl : t ++ [a] = []
· simp at htl
· change (b :: (t ++ [a])).getLast h = a
have hcons : (b :: (t ++ [a])).getLast h = (t ++ [a]).getLast htl :=
getLast_cons_any htl h
rw [hcons]
exact ih htl
head through an equality of the lists (proof args differ).
lemma head_eq_of_eq {l l' : List V} (hl : l = l') (hne : l ≠ []) (hne' : l' ≠ []) :
l.head hne = l'.head hne' := by
cases l' with
| nil => simp at hne'
| cons b t =>
subst l
rfl
getLast through an equality of the lists (proof args differ).
lemma getLast_eq_of_eq {l l' : List V} (hl : l = l') (hne : l ≠ []) (hne' : l' ≠ []) :
l.getLast hne = l'.getLast hne' := by
cases l' with
| nil => simp at hne'
| cons b t =>
subst l
cases t with
| nil => rfl
| cons c t' => rfl
The head of l ++ l₂ with l nonempty is the head of l.
lemma head_append_of_left_ne_nil' {l l2 : List V} (h : l ≠ []) (h' : l ++ l2 ≠ []) :
(l ++ l2).head h' = l.head h := by
cases l with
| nil => simp at h
| cons b t => rflThe cost of the empty path is zero.
The cost of a path starting with v decomposes as the first edge plus the
rest of the path.
lemma pathCost_cons_nonempty (w : Graph V) (v : V) {cs : List V} (h : cs ≠ []) :
pathCost w (v :: cs) = w v (cs.head h) + pathCost w cs := by
cases cs with
| nil => simp at h
| cons a rest => rflThe cost of a concatenation of two nonempty paths: the sum of the parts plus the edge joining them.
lemma pathCost_append_nonempty (w : Graph V) {l1 l2 : List V} (h1 : l1 ≠ []) (h2 : l2 ≠ []) :
pathCost w (l1 ++ l2) = pathCost w l1 + pathCost w l2 + w (l1.getLast h1) (l2.head h2) := by
induction l1 with
| nil => simp at h1
| cons v t ih =>
cases t with
| nil =>
change pathCost w (v :: l2) = pathCost w [v] + pathCost w l2 + w ([v].getLast h1) (l2.head h2)
rw [pathCost_cons_nonempty w v h2]
simp
ac_rfl
| cons a t' =>
have ht : a :: t' ≠ [] := by simp
have hrest : (a :: t') ++ l2 ≠ [] := by simp [ht]
rw [List.cons_append]
rw [pathCost_cons_nonempty w v hrest]
rw [pathCost_cons_nonempty w v ht]
rw [ih ht]
have hhead : ((a :: t') ++ l2).head hrest = (a :: t').head ht := by
simp
rw [hhead]
rw [getLast_cons_any ht h1]
omega
A Finset sum equals the sum over its toList.
lemma finset_sum_toList {α : Type} (s : Finset α) (f : α → Nat) :
(s.toList.map f).sum = s.sum f := by
simpA Finset sum equals the sum over the list of its attached elements.
lemma finset_sum_attach_toList {α : Type} [DecidableEq α] (s : Finset α) (f : α → Nat) :
(s.attach.toList.map (fun x : {a : α // a ∈ s} => f x.1)).sum = s.sum f := by
calc
(s.attach.toList.map (fun x : {a : α // a ∈ s} => f x.1)).sum
= s.attach.sum (fun x : {a : α // a ∈ s} => f x.1) := by
exact finset_sum_toList s.attach (fun x : {a : α // a ∈ s} => f x.1)
_ = s.sum f := by rw [Finset.sum_attach]
Congruence for list sums of Nat-valued functions.
lemma sum_map_congr {α : Type} {f g : α → Nat} {l : List α} (h : ∀ a ∈ l, f a = g a) :
(l.map f).sum = (l.map g).sum := by
induction l with
| nil => rfl
| cons a t ih =>
have hda : f a = g a := h a (by simp)
have ih' : (t.map f).sum = (t.map g).sum := ih (fun b hb => h b (by simp [hb]))
simp [List.sum_cons, hda, ih']
A rooted tree on the vertex type: a parent map p : V → V together with a
root r fixed by p, such that every vertex reaches the root by iterating p.
The edge set of the tree is {(v, p v) | v ≠ r}. This total-function model is
acyclic by construction: a non-root vertex on a cycle of p could never reach
the root. CLRS §35.2's APPROX-TSP-TOUR uses a minimum spanning tree of the
complete graph; we model any such tree this way.
structure TreeOn (p : V → V) (r : V) : Prop where
root_fixed : p r = r
reaches_root : ∀ v : V, ∃ n : Nat, p^[n] v = r
The tree cost of a rooted tree: the sum of the weights w v (p v) of the
edges from non-root vertices to their parents. The edge into the root has no
parent-edge and is not counted.
def treeCost (w : Graph V) (p : V → V) (r : V) : Nat :=
(Finset.univ.erase r).sum (fun v : V => w v (p v))A minimum spanning tree of the complete graph: a rooted tree whose cost is no larger than that of any other rooted tree.
def IsMinimumSpanningTreeOn (w : Graph V) (p : V → V) (r : V) : Prop :=
TreeOn p r ∧ ∀ (p' : V → V) (r' : V), TreeOn p' r' → treeCost w p r ≤ treeCost w p' r'
A tour: a cyclic permutation of the vertices — a bijection σ whose
iterates reach every vertex, so σ is a single cycle visiting all of V.
This is the Hamiltonian cycle model of CLRS §35.2.
structure Tour (σ : V → V) : Prop where
bijective : Function.Bijective σ
reachable : ∀ u v : V, ∃ n : Nat, σ^[n] u = v
The cost of a tour σ: the sum over v of the weight of the edge from
v to σ v. For a cyclic permutation on V, this counts each of the |V|
tour edges exactly once.
def TourCost (w : Graph V) (σ : V → V) : Nat :=
(Finset.univ.sum fun v : V => w v (σ v))namespace TreeOnvariable {p : V → V} {r : V}
The depth of v in a rooted tree: the least n with p^[n] v = r (and 0
if v never reaches r, a junk value under the total-function convention).
noncomputable def depth (p : V → V) (r : V) (v : V) : Nat := by
classical
exact if h : ∃ n : Nat, p^[n] v = r then Nat.find h else 0
lemma depth_spec (hT : TreeOn p r) (v : V) : p^[depth p r v] v = r := by
classical
unfold depth
rw [dif_pos (hT.reaches_root v)]
exact Nat.find_spec (hT.reaches_root v)
lemma depth_min (hT : TreeOn p r) (v : V) {m : Nat} (hm : m < depth p r v) : p^[m] v ≠ r := by
classical
unfold depth at hm
rw [dif_pos (hT.reaches_root v)] at hm
exact Nat.find_min (hT.reaches_root v) hmlemma depth_le_of_iterate (hT : TreeOn p r) (v : V) {m : Nat} (hm : p^[m] v = r) :
depth p r v ≤ m := by
by_contra h
exact hT.depth_min v (Nat.lt_of_not_ge h) hm
Iterating p at the root stays at the root.
lemma iterate_root (hT : TreeOn p r) (k : Nat) : p^[k] r = r := by
induction k with
| zero => rfl
| succ k ih => simp [Function.iterate_succ_apply, ih, hT.root_fixed]
The distinct iterates of v before it reaches the root: p^[i] v ≠ p^[j] v
whenever i < j ≤ depth.
lemma iterates_ne_of_lt (hT : TreeOn p r) (v : V) {i j : Nat} (hij : i < j)
(hj : j ≤ depth p r v) : p^[i] v ≠ p^[j] v := by
intro heq
have hmod : p^[depth p r v - j + i] v = r := by
calc
p^[depth p r v - j + i] v = p^[depth p r v - j] (p^[i] v) := by
rw [show depth p r v = (depth p r v - j) + j by omega]
simpa [Function.iterate_add]
_ = p^[depth p r v - j] (p^[j] v) := by rw [heq]
_ = p^[depth p r v] v := by
calc
p^[depth p r v - j] (p^[j] v) = p^[(depth p r v - j) + j] v := by
simpa [Function.iterate_add]
_ = p^[depth p r v] v := by
congr 1
omega
_ = r := hT.depth_spec v
have hlt : depth p r v - j + i < depth p r v := by omega
exact hT.depth_min v hlt hmod
depth is bounded by the number of vertices, since the iterates up to the
root are all distinct.
lemma depth_le_card (hT : TreeOn p r) (v : V) : depth p r v ≤ Fintype.card V := by
classical
have hinj : Function.Injective (fun k : Fin (depth p r v + 1) => p^[k.1] v) := by
intro a b hab
apply Fin.ext
by_contra hne
have h : a.1 < b.1 ∨ b.1 < a.1 := lt_or_gt_of_ne hne
rcases h with hlt | hlt
· exact False.elim (hT.iterates_ne_of_lt v hlt (Nat.le_of_lt_succ (Fin.isLt b)) hab)
· exact False.elim (hT.iterates_ne_of_lt v hlt (Nat.le_of_lt_succ (Fin.isLt a)) hab.symm)
have hcard : Fintype.card (Fin (depth p r v + 1)) ≤ Fintype.card V :=
Fintype.card_le_of_injective (fun k : Fin (depth p r v + 1) => p^[k.1] v) hinj
have hcard' : depth p r v + 1 ≤ Fintype.card V := by simpa using hcard
omega
lemma depth_ne_zero (hT : TreeOn p r) (v : V) (hv : v ≠ r) : depth p r v ≠ 0 := by
intro h0
have hs := hT.depth_spec v
have : v = r := by simpa [h0] using hs
exact hv this
Moving from v to its parent decreases the depth by one.
lemma depth_succ (hT : TreeOn p r) (v : V) (hv : v ≠ r) : depth p r (p v) + 1 = depth p r v := by
have hd : depth p r v ≠ 0 := hT.depth_ne_zero v hv
apply Nat.le_antisymm
· have h1 : p^[depth p r v - 1] (p v) = r := by
have hd' := hT.depth_spec v
rw [show depth p r v = (depth p r v - 1) + 1 by omega] at hd'
simpa [Function.iterate_add] using hd'
have hle : depth p r (p v) ≤ depth p r v - 1 := hT.depth_le_of_iterate (p v) h1
omega
· have h2 : p^[depth p r (p v) + 1] v = r := by
have hd' := hT.depth_spec (p v)
simpa [Function.iterate_add] using hd'
exact hT.depth_le_of_iterate v h2A child lies exactly one level below its parent.
lemma depth_child_succ (hT : TreeOn p r) {c v : V} (hpc : p c = v) (hcne : c ≠ r) :
depth p r c = depth p r v + 1 := by
calc
depth p r c = depth p r (p c) + 1 := (hT.depth_succ c hcne).symm
_ = depth p r v + 1 := by rw [hpc]
Applying p k times (at most depth) lowers the depth by k.
lemma depth_iterate (hT : TreeOn p r) (v : V) : ∀ k : Nat, k ≤ depth p r v →
depth p r (p^[k] v) = depth p r v - k := by
intro k
induction k with
| zero => simp
| succ k ih =>
intro hk
have hk' : k ≤ depth p r v := by omega
have hkd := ih hk'
have hne : p^[k] v ≠ r := hT.depth_min v (by omega)
have hs : depth p r (p (p^[k] v)) + 1 = depth p r (p^[k] v) := hT.depth_succ (p^[k] v) hne
calc
depth p r (p^[k + 1] v) = depth p r (p (p^[k] v)) := by
rw [Function.iterate_succ_apply']
_ = depth p r (p^[k] v) - 1 := by
have hne0 : depth p r (p^[k] v) ≠ 0 := hT.depth_ne_zero (p^[k] v) hne
omega
_ = (depth p r v - k) - 1 := by rw [hkd]
_ = depth p r v - (k + 1) := by omega
If the i-th iterate of u is a non-root vertex, then i does not pass
u's depth.
lemma iterate_le_depth_of_ne_root (hT : TreeOn p r) {u : V} {i : Nat} {x : V}
(hu : p^[i] u = x) (hx : x ≠ r) : i ≤ depth p r u := by
by_contra h
have hgt : depth p r u < i := Nat.lt_of_not_ge h
have hcalc : p^[i] u = r := by
calc
p^[i] u = p^[i - depth p r u] (p^[depth p r u] u) := by
calc
p^[i] u = p^[(i - depth p r u) + depth p r u] u := by
congr 1
omega
_ = p^[i - depth p r u] (p^[depth p r u] u) := by
simpa [Function.iterate_add]
_ = p^[i - depth p r u] r := by rw [hT.depth_spec u]
_ = r := hT.iterate_root (i - depth p r u)
rw [hu] at hcalc
exact hx hcalcend TreeOn
The children of v in the rooted tree: the non-root vertices whose
parent is v.
def children (p : V → V) (r : V) (v : V) : Finset V :=
Finset.univ.filter (fun c => c ≠ r ∧ p c = v)
The subtree rooted at v: every vertex whose parent chain passes through
v (equivalently, that reaches v by iterating p).
def subtree (p : V → V) (r : V) (v : V) : Finset V := by
classical
exact Finset.univ.filter (fun x => ∃ k : Nat, p^[k] x = v)
The cost of the subtree rooted at v: the sum of the weights of the tree
edges with both endpoints in the subtree (each non-root vertex's edge to its
parent).
def subtreeCost (w : Graph V) (p : V → V) (r : V) (v : V) : Nat :=
(subtree p r v).sum (fun x => w x (p x))
The spanning tree obtained by deleting the edge (r, σ r) from a tour σ: the
root r is fixed, and every other vertex points to its tour successor. Because
σ is a single cycle through all of V, iterating this parent map from any
vertex reaches r.
def deleteTourEdge (σ : V → V) (r : V) (v : V) : V :=
if v = r then r else σ v
Deleting one edge from a tour leaves a spanning tree: deleteTourEdge σ r
is a rooted tree on V.
theorem deleteTourEdge_tree {σ : V → V} {r : V} (hT : Tour σ) :
TreeOn (deleteTourEdge σ r) r := by
refine ⟨?root_fixed, ?reaches_root⟩
· simp [deleteTourEdge]
· intro x
by_cases hxr : x = r
· subst hxr
exact ⟨0, rfl⟩
· let m := Nat.find (hT.reachable x r)
have hmspec : σ^[m] x = r := Nat.find_spec (hT.reachable x r)
have hmin : ∀ k : Nat, k < m → σ^[k] x ≠ r :=
fun k hk => Nat.find_min (hT.reachable x r) hk
have hiter : ∀ k : Nat, k ≤ m → (deleteTourEdge σ r)^[k] x = σ^[k] x := by
intro k
induction k with
| zero => intro hk; simp
| succ k ih =>
intro hks
have hk_lt : k < m := by omega
have hne : σ^[k] x ≠ r := hmin k hk_lt
have ih' : (deleteTourEdge σ r)^[k] x = σ^[k] x := ih (by omega)
calc
(deleteTourEdge σ r)^[k + 1] x = deleteTourEdge σ r ((deleteTourEdge σ r)^[k] x) := by
rw [Function.iterate_succ_apply']
_ = deleteTourEdge σ r (σ^[k] x) := by rw [ih']
_ = σ (σ^[k] x) := by
simp [deleteTourEdge, hne]
_ = σ^[k + 1] x := by
rw [Function.iterate_succ_apply']
exact ⟨m, by rw [hiter m (le_rfl)]; exact hmspec⟩Lemma 35.3. A minimum spanning tree costs no more than any tour.
Indeed, deleting one edge from a tour leaves a spanning tree whose cost is at most the tour's (the deleted edge contributes a nonnegative amount), and the MST is minimal among all spanning trees.
theorem mst_le_tour {w : Graph V} {p : V → V} {r : V}
(hMST : IsMinimumSpanningTreeOn w p r) {σ : V → V} (hT : Tour σ) :
treeCost w p r ≤ TourCost w σ := by
let d : V → V := deleteTourEdge σ r
have hTree : TreeOn d r := deleteTourEdge_tree hT
have hle : treeCost w d r ≤ TourCost w σ := by
unfold treeCost TourCost
rw [show (Finset.univ.erase r).sum (fun x : V => w x (d x)) =
(Finset.univ.erase r).sum (fun x : V => w x (σ x)) by
apply Finset.sum_congr
· simp
· intro x hx
have hxne : x ≠ r := (Finset.mem_erase.mp hx).1
simp [d, deleteTourEdge, hxne]]
exact Finset.sum_le_sum_of_subset_of_nonneg
(by intro x hx; exact Finset.mem_univ x)
(by intro x hx1 hx2; exact Nat.zero_le _)
exact le_trans (hMST.2 d r hTree) hlenamespace TreeOnvariable {p : V → V} {r : V}
A child lies strictly deeper than its parent, so the "remaining budget"
card V - depth strictly decreases when recursing from a parent to a child.
This is the termination measure for the depth-first walk and preorder
definitions.
lemma children_depth_lt (hT : TreeOn p r) {c v : V} (hc : c ∈ children p r v) :
Fintype.card V - depth p r c < Fintype.card V - depth p r v := by
classical
rcases Finset.mem_filter.mp hc with ⟨_, hcpc⟩
rcases hcpc with ⟨hcne, hpc⟩
have hdepth : depth p r c = depth p r v + 1 := hT.depth_child_succ hpc hcne
have hlt_card : depth p r v < Fintype.card V := by
by_contra h
have hge : Fintype.card V ≤ depth p r v := Nat.le_of_not_gt h
have heq : depth p r v = Fintype.card V := le_antisymm (hT.depth_le_card v) hge
have hc_card : depth p r c ≤ Fintype.card V := hT.depth_le_card c
omega
omega
The depth-first walk of the tree starting and ending at v, covering the
subtree rooted at v: v, then for each child c the walk of c's subtree
followed by the return edge to v. Every tree edge in the subtree is
traversed exactly twice (once down, once up).
The recursion is carried out with WellFounded.fix on the measure
card V - depth, threading each child's membership proof through the
attached children so the well-founded induction hypothesis is applicable.
noncomputable def dfsWalkFrom (hT : TreeOn p r) : (v : V) → List V := by
classical
let R : V → V → Prop := fun a b => Fintype.card V - depth p r a < Fintype.card V - depth p r b
have hwf : WellFounded R := (measure (fun a : V => Fintype.card V - depth p r a)).wf
exact hwf.fix (C := fun _ => List V) (fun v ih =>
[v] ++ ((children p r v).attach.toList.flatMap (fun xc => ih xc.1 (children_depth_lt hT xc.2) ++ [v])))The depth-first walk of the whole tree, starting and ending at the root.
noncomputable def dfsWalk (hT : TreeOn p r) : List V :=
dfsWalkFrom hT r
The preorder list of the subtree rooted at v: each vertex visited before
its children's vertices, in the order of the children.
noncomputable def preorder (hT : TreeOn p r) : (v : V) → List V := by
classical
let R : V → V → Prop := fun a b => Fintype.card V - depth p r a < Fintype.card V - depth p r b
have hwf : WellFounded R := (measure (fun a : V => Fintype.card V - depth p r a)).wf
exact hwf.fix (C := fun _ => List V) (fun v ih =>
v :: ((children p r v).attach.toList.flatMap (fun xc => ih xc.1 (children_depth_lt hT xc.2))))
The tour returned by APPROX-TSP-TOUR: the vertices of the whole tree in
depth-first preorder, interpreted as a Hamiltonian cycle in dfsTour_isTour.
The recursion equation for dfsWalkFrom: the walk from v visits v, then
walks each child's subtree and returns to v.
-- Walk and cost machinery for Lemma 35.2 ---------------------------------
lemma dfsWalkFrom_fix (hT : TreeOn p r) (v : V) :
dfsWalkFrom hT v =
[v] ++ ((children p r v).attach.toList.flatMap
(fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])) := by
classical
unfold dfsWalkFrom
dsimp only
rw [WellFounded.fix_eq]The walk from any vertex is nonempty.
lemma dfsWalkFrom_ne_nil (hT : TreeOn p r) (v : V) : dfsWalkFrom hT v ≠ [] := by
rw [dfsWalkFrom_fix hT v]
simp
The walk from v starts at v.
lemma dfsWalkFrom_head (hT : TreeOn p r) (v : V) :
(dfsWalkFrom hT v).head (dfsWalkFrom_ne_nil hT v) = v := by
calc
(dfsWalkFrom hT v).head (dfsWalkFrom_ne_nil hT v)
= ([v] ++ (children p r v).attach.toList.flatMap
(fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])).head (by simp) := by
exact head_eq_of_eq (dfsWalkFrom_fix hT v) (dfsWalkFrom_ne_nil hT v) (by simp)
_ = v := by simp
If every g a is nonempty, then l.flatMap g is nonempty whenever l is.
lemma flatMap_append_ne_nil {α β : Type} {g : α → List β} (hg : ∀ a, g a ≠ []) :
∀ l : List α, l ≠ [] → l.flatMap g ≠ [] := by
intro l
cases l with
| nil => simp
| cons a t =>
rw [List.flatMap_cons]
intro _
intro h
exact hg a (List.append_eq_nil_iff.mp h).1
Every segment of the walk (dfsWalkFrom c ++ [v]) ends in v, so the
concatenated children list ends in v.
lemma flatMap_last_v (hT : TreeOn p r) {v : V} :
∀ cs : List {c : V // c ∈ children p r v},
(hne : cs.flatMap (fun xc => dfsWalkFrom hT xc.1 ++ [v]) ≠ []) →
(cs.flatMap (fun xc => dfsWalkFrom hT xc.1 ++ [v])).getLast hne = v := by
intro cs
induction cs with
| nil => intro hne; simp at hne
| cons xc rest ih =>
intro hne
by_cases hre : rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]) = []
· have hrest_nil : rest = [] := by
by_contra hrn
have hne' : rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]) ≠ [] :=
flatMap_append_ne_nil (fun xc => by simp [dfsWalkFrom_ne_nil hT xc.1]) rest hrn
exact hne' hre
subst hrest_nil
have hflat : (xc :: []).flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]) = dfsWalkFrom hT xc.1 ++ [v] := by
simp
have hne1 : dfsWalkFrom hT xc.1 ++ [v] ≠ [] := by simp [dfsWalkFrom_ne_nil hT xc.1]
calc
((xc :: []).flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])).getLast hne
= (dfsWalkFrom hT xc.1 ++ [v]).getLast hne1 := getLast_eq_of_eq hflat hne hne1
_ = v := getLast_append_singleton' (dfsWalkFrom hT xc.1) hne1
· have hflat : (xc :: rest).flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])
= (dfsWalkFrom hT xc.1 ++ [v]) ++ rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]) := by
rw [List.flatMap_cons]
have hne1 : (dfsWalkFrom hT xc.1 ++ [v]) ++ rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]) ≠ [] := by
simp [hre]
calc
((xc :: rest).flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])).getLast hne
= ((dfsWalkFrom hT xc.1 ++ [v]) ++ rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])).getLast hne1 := getLast_eq_of_eq hflat hne hne1
_ = (rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])).getLast hre :=
getLast_append_of_right_ne_nil' (dfsWalkFrom hT xc.1 ++ [v])
(rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])) hne1 hre
_ = v := ih hre
The walk from v returns to v.
lemma dfsWalkFrom_last (hT : TreeOn p r) (v : V) :
(dfsWalkFrom hT v).getLast (dfsWalkFrom_ne_nil hT v) = v := by
let cs := (children p r v).attach.toList
have hfix : dfsWalkFrom hT v = [v] ++ cs.flatMap
(fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]) := dfsWalkFrom_fix hT v
have hneFix : [v] ++ cs.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]) ≠ [] := by simp
have hlast : ([v] ++ cs.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])).getLast hneFix = v := by
by_cases hre : cs.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]) = []
· have hlist : [v] ++ cs.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]) = [v] := by
rw [hre]
simp
calc
([v] ++ cs.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])).getLast hneFix
= [v].getLast (by simp) := getLast_eq_of_eq hlist hneFix (by simp)
_ = v := rfl
· have htail : (cs.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])).getLast hre = v :=
flatMap_last_v hT cs hre
exact (getLast_append_of_right_ne_nil' [v]
(cs.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])) hneFix hre) ▸ htail
calc
(dfsWalkFrom hT v).getLast (dfsWalkFrom_ne_nil hT v)
= ([v] ++ cs.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])).getLast hneFix :=
getLast_eq_of_eq hfix (dfsWalkFrom_ne_nil hT v) hneFix
_ = v := hlast
The cost of a child's walk plus the return edge to v telescopes to the
walk cost plus the child edge.
lemma pathCost_dfsWalkFrom_append_singleton (hT : TreeOn p r) (w : Graph V) (v : V) (c : V) :
pathCost w (dfsWalkFrom hT c ++ [v]) = walkCost w (dfsWalkFrom hT c) + w c v := by
rw [pathCost_append_nonempty w (dfsWalkFrom_ne_nil hT c) (by simp)]
rw [dfsWalkFrom_last hT c]
simp [walkCost, pathCost]
The walk [v] ++ flatMap (fun c => dfsWalkFrom c ++ [v]) decomposes into a
sum over the children: for each child c, the edge v → c plus the child's
segment.
lemma pathCost_walk_segments (w : Graph V) (hT : TreeOn p r) {v : V}
(cs : List {c : V // c ∈ children p r v}) :
pathCost w ([v] ++ (cs.flatMap (fun xc => dfsWalkFrom hT xc.1 ++ [v])))
= (cs.map (fun xc : {c : V // c ∈ children p r v} => w v xc.1 + pathCost w (dfsWalkFrom hT xc.1 ++ [v]))).sum := by
induction cs with
| nil => simp [pathCost]
| cons xc rest ih =>
rw [List.flatMap_cons]
have hg : dfsWalkFrom hT xc.1 ++ [v] ≠ [] := by simp [dfsWalkFrom_ne_nil hT xc.1]
have hlead : [v] ≠ [] := by simp
have hSeg : pathCost w ([v] ++ (dfsWalkFrom hT xc.1 ++ [v])) =
pathCost w (dfsWalkFrom hT xc.1 ++ [v]) + w v xc.1 := by
rw [pathCost_append_nonempty w hlead hg]
simp [List.getLast_singleton]
have hhead : (dfsWalkFrom hT xc.1 ++ [v]).head hg = xc.1 := by
rw [head_append_of_left_ne_nil' (dfsWalkFrom_ne_nil hT xc.1) hg]
exact dfsWalkFrom_head hT xc.1
rw [hhead]
ac_rfl
by_cases hre : rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]) = []
· have hrest_nil : rest = [] := by
by_contra hrn
have hne' : rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]) ≠ [] :=
flatMap_append_ne_nil (fun xc => by simp [dfsWalkFrom_ne_nil hT xc.1]) rest hrn
exact hne' hre
subst hrest_nil
simp
rw [pathCost_cons_nonempty w v hg]
have hhead : (dfsWalkFrom hT xc.1 ++ [v]).head hg = xc.1 := by
rw [head_append_of_left_ne_nil' (dfsWalkFrom_ne_nil hT xc.1) hg]
exact dfsWalkFrom_head hT xc.1
rw [hhead]
· rw [← List.append_assoc]
have hApp : pathCost w (([v] ++ (dfsWalkFrom hT xc.1 ++ [v])) ++ rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])) =
pathCost w ([v] ++ (dfsWalkFrom hT xc.1 ++ [v]))
+ pathCost w (rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]))
+ w v ((rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])).head hre) := by
have hne1 : [v] ++ (dfsWalkFrom hT xc.1 ++ [v]) ≠ [] := by simp
rw [pathCost_append_nonempty w hne1 hre]
have hlast : ([v] ++ (dfsWalkFrom hT xc.1 ++ [v])).getLast hne1 = v := by
rw [getLast_append_of_right_ne_nil' [v] (dfsWalkFrom hT xc.1 ++ [v]) hne1 hg]
exact getLast_append_singleton' (dfsWalkFrom hT xc.1) hg
rw [hlast]
rw [hApp]
rw [hSeg]
have hRest : pathCost w (rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]))
+ w v ((rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])).head hre)
= pathCost w ([v] ++ rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])) := by
rw [pathCost_append_nonempty w hlead hre]
simp [List.getLast_singleton]
ac_rfl
have hcomb : pathCost w (dfsWalkFrom hT xc.1 ++ [v]) + w v xc.1 +
(pathCost w (rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]))
+ w v ((rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])).head hre))
= (pathCost w (dfsWalkFrom hT xc.1 ++ [v]) + w v xc.1) + pathCost w (rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]))
+ w v ((rest.flatMap (fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v])).head hre) := by
ac_rfl
rw [← hcomb]
rw [hRest]
rw [ih]
simp
ac_rfl
The walk cost from v is the sum over the children of (child walk cost plus
the two edges joining them).
lemma dfsWalkFrom_cost_rec (hT : TreeOn p r) (w : Graph V) (v : V) :
walkCost w (dfsWalkFrom hT v)
= ((children p r v).attach.toList.map
(fun xc : {c : V // c ∈ children p r v} =>
walkCost w (dfsWalkFrom hT xc.1) + w xc.1 v + w v xc.1)).sum := by
rw [dfsWalkFrom_fix hT v]
change pathCost w ([v] ++ (children p r v).attach.toList.flatMap
(fun xc : {c : V // c ∈ children p r v} => dfsWalkFrom hT xc.1 ++ [v]))
= ((children p r v).attach.toList.map
(fun xc : {c : V // c ∈ children p r v} => walkCost w (dfsWalkFrom hT xc.1) + w xc.1 v + w v xc.1)).sum
rw [pathCost_walk_segments w hT (children p r v).attach.toList]
apply sum_map_congr
intro xc hxc
rw [pathCost_dfsWalkFrom_append_singleton hT w v xc.1]
ac_rfl
Same as dfsWalkFrom_cost_rec, with the sum over the children Finset.
lemma dfsWalkFrom_cost_rec_finset (hT : TreeOn p r) (w : Graph V) (v : V) :
walkCost w (dfsWalkFrom hT v)
= (children p r v).sum (fun c => walkCost w (dfsWalkFrom hT c) + w c v + w v c) := by
rw [dfsWalkFrom_cost_rec hT w v]
exact finset_sum_attach_toList (children p r v) (fun c => walkCost w (dfsWalkFrom hT c) + w c v + w v c)
Membership in a subtree: x lies in subtree v iff x = v or x lies in
the subtree of a child of v.
-- Subtree decomposition -------------------------------------------------
lemma subtree_mem_iff (hT : TreeOn p r) (x v : V) :
x ∈ subtree p r v ↔ x = v ∨ ∃ c : V, c ∈ children p r v ∧ x ∈ subtree p r c := by
classical
rw [subtree]
simp only [Finset.mem_filter, Finset.mem_univ, true_and]
constructor
· intro h
rcases h with ⟨k, hk⟩
by_cases hxv : x = v
· exact Or.inl hxv
· right
have hexists : ∃ n : Nat, p^[n] x = v := ⟨k, hk⟩
let k0 := Nat.find hexists
have hk0 : p^[k0] x = v := Nat.find_spec hexists
have hk0min : ∀ n : Nat, n < k0 → p^[n] x ≠ v := fun n hn => Nat.find_min hexists hn
have hk0pos : 0 < k0 := by
by_contra hz
have hk0zero : k0 = 0 := by omega
have : x = v := by simpa [hk0zero] using hk0
exact hxv this
refine ⟨p^[k0 - 1] x, ?memc, ?subc⟩
· rw [children]
rw [Finset.mem_filter]
constructor
· exact Finset.mem_univ (p^[k0 - 1] x)
· constructor
· intro hcr
have hpr : p^[k0] x = r := by
calc
p^[k0] x = p (p^[k0 - 1] x) := by
conv_lhs =>
rw [show k0 = (k0 - 1) + 1 by omega]
rw [Function.iterate_succ_apply']
_ = r := by
rw [hcr]
exact hT.root_fixed
have hv : v = r := hk0.symm.trans hpr
apply hk0min (k0 - 1) (by omega)
calc
p^[k0 - 1] x = r := hcr
_ = v := hv.symm
· change p (p^[k0 - 1] x) = v
calc
p (p^[k0 - 1] x) = p^[k0] x := by
conv_rhs =>
rw [show k0 = (k0 - 1) + 1 by omega]
rw [Function.iterate_succ_apply']
_ = v := hk0
· rw [subtree]
rw [Finset.mem_filter]
exact ⟨Finset.mem_univ x, ⟨k0 - 1, rfl⟩⟩
· intro h
rcases h with hxv | ⟨c, hc, hsub⟩
· subst x
exact ⟨0, rfl⟩
· rw [subtree] at hsub
simp at hsub
have hpc : p c = v := (Finset.mem_filter.mp hc).2.2
rcases hsub with ⟨k, hk⟩
exact ⟨k + 1, by
calc
p^[k + 1] x = p (p^[k] x) := by
rw [Function.iterate_succ_apply']
_ = p c := by rw [hk]
_ = v := hpc⟩
Two children of v whose iterates of x reach them must coincide.
lemma child_subtree_depth (hT : TreeOn p r) (v : V) {c1 c2 : V} {i j : Nat}
(hc1 : c1 ∈ children p r v) (hc2 : c2 ∈ children p r v) (hij : i ≤ j)
{x : V} (hi : p^[i] x = c1) (hj : p^[j] x = c2) : c1 = c2 := by
classical
have hstep : p^[j - i] c1 = c2 := by
calc
p^[j - i] c1 = p^[j - i] (p^[i] x) := by rw [hi]
_ = p^[j] x := by
rw [show j = (j - i) + i by omega]
simp [Function.iterate_add]
_ = c2 := hj
by_cases hji0 : j - i = 0
· simpa [hji0] using hstep
· have hji_pos : 0 < j - i := Nat.pos_of_ne_zero hji0
rcases Finset.mem_filter.mp hc1 with ⟨_, hc1p⟩
rcases Finset.mem_filter.mp hc2 with ⟨_, hc2p⟩
rcases hc1p with ⟨hc1ne, hpc1⟩
rcases hc2p with ⟨hc2ne, hpc2⟩
have hd1 : depth p r c1 = depth p r v + 1 := hT.depth_child_succ hpc1 hc1ne
have hd2 : depth p r c2 = depth p r v + 1 := hT.depth_child_succ hpc2 hc2ne
have hle : j - i ≤ depth p r c1 :=
iterate_le_depth_of_ne_root hT (u := c1) (i := j - i) (x := c2) hstep hc2ne
have hiter := hT.depth_iterate c1 (j - i) hle
have hdep : depth p r c2 = depth p r c1 - (j - i) := by
rw [hstep] at hiter
exact hiter
have hlt : (depth p r v + 1) - (j - i) < depth p r v + 1 := by omega
have hfalse : depth p r v + 1 < depth p r v + 1 := by
calc
depth p r v + 1 = depth p r c2 := hd2.symm
_ = depth p r c1 - (j - i) := hdep
_ = (depth p r v + 1) - (j - i) := by rw [hd1]
_ < depth p r v + 1 := hlt
omega
The subtrees of distinct children of v are pairwise disjoint.
lemma children_subtree_disjoint (hT : TreeOn p r) (v : V) :
(children p r v : Set V).PairwiseDisjoint (fun c => subtree p r c) := by
classical
intro c1 hc1 c2 hc2 hne
change Disjoint (subtree p r c1) (subtree p r c2)
rw [Finset.disjoint_left]
intro x hx1 hx2
rw [subtree] at hx1 hx2
rcases Finset.mem_filter.mp hx1 with ⟨_, ⟨i, hi⟩⟩
rcases Finset.mem_filter.mp hx2 with ⟨_, ⟨j, hj⟩⟩
by_cases hij : i ≤ j
· exact hne (child_subtree_depth hT v hc1 hc2 hij hi hj)
· have hji : j ≤ i := by omega
have : c2 = c1 := child_subtree_depth hT v hc2 hc1 hji hj hi
exact hne this.symmA vertex does not lie in the subtree of its own child.
lemma v_not_mem_child_subtree (hT : TreeOn p r) {c v : V} (hc : c ∈ children p r v) :
v ∉ subtree p r c := by
classical
rw [subtree]
intro hv
rcases Finset.mem_filter.mp hv with ⟨_, ⟨k, hk⟩⟩
rcases Finset.mem_filter.mp hc with ⟨_, hcp⟩
rcases hcp with ⟨hcne, hpc⟩
have hd : depth p r c = depth p r v + 1 := hT.depth_child_succ hpc hcne
have hle : k ≤ depth p r v := iterate_le_depth_of_ne_root hT (u := v) (i := k) (x := c) hk hcne
have hiter := hT.depth_iterate v k hle
have hdep : depth p r c = depth p r v - k := by
rw [hk] at hiter
exact hiter
have hlt : depth p r v - k < depth p r v + 1 := by omega
have hfalse : depth p r v + 1 < depth p r v + 1 := by
calc
depth p r v + 1 = depth p r c := hd.symm
_ = depth p r v - k := hdep
_ < depth p r v + 1 := hlt
omega
The subtree of v is v together with the disjoint union of its children's
subtrees.
lemma subtree_eq_insert_disjiUnion (hT : TreeOn p r) (v : V) :
subtree p r v = insert v (Finset.disjiUnion (children p r v) (fun c => subtree p r c) (children_subtree_disjoint hT v)) := by
classical
ext x
rw [Finset.mem_insert, Finset.mem_disjiUnion]
exact subtree_mem_iff hT x vThe subtree cost decomposes as the vertex's own edge plus the sum of its children's subtree costs (as a list sum over the attached children).
lemma subtreeCost_rec (hT : TreeOn p r) (w : Graph V) (v : V) :
subtreeCost w p r v = w v (p v) + ((children p r v).attach.toList.map (fun xc : {c : V // c ∈ children p r v} => subtreeCost w p r xc.1)).sum := by
classical
unfold subtreeCost
rw [subtree_eq_insert_disjiUnion hT v]
have hvnotin : v ∉ Finset.disjiUnion (children p r v) (fun c => subtree p r c) (children_subtree_disjoint hT v) := by
rw [Finset.mem_disjiUnion]
intro h
rcases h with ⟨c, hc, hvc⟩
exact v_not_mem_child_subtree hT hc hvc
rw [Finset.sum_insert hvnotin]
congr 1
rw [Finset.sum_disjiUnion]
exact (finset_sum_attach_toList (children p r v) (fun c => subtreeCost w p r c)).symm
Same as subtreeCost_rec, with the sum over the children Finset.
lemma subtreeCost_rec_finset (hT : TreeOn p r) (w : Graph V) (v : V) :
subtreeCost w p r v = w v (p v) + (children p r v).sum (fun c => subtreeCost w p r c) := by
rw [subtreeCost_rec hT w v]
congr 1
exact finset_sum_attach_toList (children p r v) (fun c => subtreeCost w p r c)
Lemma (walk cost). The depth-first walk from v over its subtree costs
twice the subtree cost, excluding v's own parent edge. This is the recursive
statement used to prove Lemma 35.2 at the root.
-- Lemma 35.2 ------------------------------------------------------------
lemma dfsWalkFrom_cost (hT : TreeOn p r) (w : Graph V) (hSymm : ∀ x y : V, w x y = w y x) (v : V) :
walkCost w (dfsWalkFrom hT v) = 2 * (subtreeCost w p r v - w v (p v)) := by
classical
let R : V → V → Prop := fun a b => Fintype.card V - depth p r a < Fintype.card V - depth p r b
have hwf : WellFounded R := (measure (fun a : V => Fintype.card V - depth p r a)).wf
refine hwf.induction (C := fun u : V =>
walkCost w (dfsWalkFrom hT u) = 2 * (subtreeCost w p r u - w u (p u))) v ?_
intro u hrec
have hchild : ∀ c ∈ children p r u,
walkCost w (dfsWalkFrom hT c) + w c u + w u c = 2 * subtreeCost w p r c := by
intro c hc
have hrec' := hrec c (children_depth_lt hT hc)
rw [hrec']
rcases Finset.mem_filter.mp hc with ⟨_, hcprops⟩
rcases hcprops with ⟨hcne, hpc⟩
have hw1 : w c (p c) = w c u := by rw [hpc]
have hw2 : w u c = w c u := hSymm u c
have hcsub : c ∈ subtree p r c := by
rw [subtree]
rw [Finset.mem_filter]
exact ⟨Finset.mem_univ c, ⟨0, rfl⟩⟩
have hle : w c (p c) ≤ subtreeCost w p r c := by
unfold subtreeCost
exact Finset.single_le_sum (fun x _ => Nat.zero_le (w x (p x))) hcsub
have hle' : w c u ≤ subtreeCost w p r c := by simpa [hw1] using hle
rw [hw1, hw2]
omega
rw [dfsWalkFrom_cost_rec_finset hT w u]
rw [subtreeCost_rec_finset hT w u]
have hsum : (children p r u).sum (fun c => walkCost w (dfsWalkFrom hT c) + w c u + w u c)
= (children p r u).sum (fun c => 2 * subtreeCost w p r c) := by
apply Finset.sum_congr
· rfl
· intro c hc
exact hchild c hc
rw [hsum]
have hcancel : w u (p u) + (children p r u).sum (fun c => subtreeCost w p r c) - w u (p u)
= (children p r u).sum (fun c => subtreeCost w p r c) := by
omega
rw [hcancel]
rw [Nat.mul_comm]
rw [Finset.sum_mul]
apply Finset.sum_congr
· rfl
· intro c hc
rw [Nat.mul_comm]Lemma 35.2. The depth-first walk of a rooted tree traverses every tree edge exactly twice, so its cost is exactly twice the tree's cost.
Under a symmetric weight function w, the full walk dfsWalk hT (from and back
to the root) costs 2 * treeCost w p r.
lemma dfsWalk_cost (hT : TreeOn p r) (w : Graph V) (hSymm : ∀ x y : V, w x y = w y x) :
walkCost w (dfsWalk hT) = 2 * treeCost w p r := by
change walkCost w (dfsWalkFrom hT r) = 2 * treeCost w p r
rw [dfsWalkFrom_cost hT w hSymm r]
have hroot : subtreeCost w p r r - w r (p r) = treeCost w p r := by
have hsub : subtreeCost w p r r = treeCost w p r + w r (p r) := by
unfold subtreeCost treeCost
have huniv : subtree p r r = Finset.univ := by
ext x
simp [subtree, hT.reaches_root x]
rw [huniv]
have hsplit : Finset.univ.sum (fun x => w x (p x)) = w r (p r) + (Finset.univ.erase r).sum (fun x => w x (p x)) := by
calc
Finset.univ.sum (fun x => w x (p x)) = (insert r (Finset.univ.erase r)).sum (fun x => w x (p x)) := by
conv_lhs =>
rw [← Finset.insert_erase (Finset.mem_univ r)]
_ = w r (p r) + (Finset.univ.erase r).sum (fun x => w x (p x)) := by
rw [Finset.sum_insert (by simp)]
rw [hsplit]
omega
rw [hsub]
exact Nat.add_sub_cancel (treeCost w p r) (w r (p r))
rw [hroot]
The recursion equation for preorder: the preorder from v visits v,
then the preorders of each child's subtree.
-- Preorder: dfsTour visits every vertex ---------------------------------
lemma preorder_fix (hT : TreeOn p r) (v : V) :
preorder hT v = v :: ((children p r v).attach.toList.flatMap
(fun xc : {c : V // c ∈ children p r v} => preorder hT xc.1)) := by
classical
unfold preorder
dsimp only
rw [WellFounded.fix_eq]
A vertex is in the preorder of v iff it lies in the subtree of v.
lemma preorder_mem_subtree (hT : TreeOn p r) (v : V) :
∀ x : V, x ∈ preorder hT v ↔ x ∈ subtree p r v := by
classical
let R : V → V → Prop := fun a b => Fintype.card V - depth p r a < Fintype.card V - depth p r b
have hwf : WellFounded R := (measure (fun a : V => Fintype.card V - depth p r a)).wf
refine hwf.induction (C := fun u : V => ∀ x : V, x ∈ preorder hT u ↔ x ∈ subtree p r u) v ?_
intro u hrec
intro x
constructor
· intro hx
rw [preorder_fix hT u] at hx
rcases List.mem_cons.mp hx with hxv | hxmem
· subst x
exact (subtree_mem_iff hT u u).2 (Or.inl rfl)
· rw [List.mem_flatMap] at hxmem
rcases hxmem with ⟨yc, hyc_mem, hxpre⟩
have hxsub : x ∈ subtree p r yc.1 := (hrec yc.1 (children_depth_lt hT yc.2) x).1 hxpre
exact (subtree_mem_iff hT x u).2 (Or.inr ⟨yc.1, yc.2, hxsub⟩)
· intro hx
rw [preorder_fix hT u]
rcases (subtree_mem_iff hT x u).1 hx with hxv | ⟨c, hc, hxsub⟩
· subst x
exact List.mem_cons_self
· have hxpre : x ∈ preorder hT c := (hrec c (children_depth_lt hT hc) x).2 hxsub
have hc_mem : (⟨c, hc⟩ : {c : V // c ∈ children p r u}) ∈ (children p r u).attach.toList := by
rw [Finset.mem_toList]
exact (Finset.mem_attach (s := children p r u) ⟨c, hc⟩)
exact List.mem_cons_of_mem u (List.mem_flatMap_of_mem hc_mem hxpre)
The preorder tour visits every vertex exactly once in the sense that every
vertex appears in it (the absence of duplicates is dfsTour_nodup below).
lemma dfsTour_mem (hT : TreeOn p r) (x : V) : x ∈ dfsTour hT := by
classical
change x ∈ preorder hT r
have hx : x ∈ subtree p r r := by
rw [subtree]
rw [Finset.mem_filter]
exact ⟨Finset.mem_univ x, hT.reaches_root x⟩
exact (preorder_mem_subtree hT r x).2 hx
The preorders of two distinct children of u are disjoint lists.
lemma preorder_disjoint_of_ne (hT : TreeOn p r) {u c1 c2 : V}
(hc1 : c1 ∈ children p r u) (hc2 : c2 ∈ children p r u) (hne : c1 ≠ c2) :
List.Disjoint (preorder hT c1) (preorder hT c2) := by
classical
rw [List.disjoint_left]
intro x hx1 hx2
have hxsub1 : x ∈ subtree p r c1 := (preorder_mem_subtree hT c1 x).1 hx1
have hxsub2 : x ∈ subtree p r c2 := (preorder_mem_subtree hT c2 x).1 hx2
have hdisj := children_subtree_disjoint hT u hc1 hc2 hne
change Disjoint (subtree p r c1) (subtree p r c2) at hdisj
rw [Finset.disjoint_left] at hdisj
exact hdisj hxsub1 hxsub2
A duplicate-free list of children with pairwise-disjoint preorders gives a
Pairwise (Disjoint on preorder) relation.
lemma pairwise_disjoint_of_nodup (hT : TreeOn p r) (u : V) :
∀ cs : List {c : V // c ∈ children p r u},
List.Nodup cs →
(∀ xc1 ∈ cs, ∀ xc2 ∈ cs, xc1 ≠ xc2 →
List.Disjoint (preorder hT xc1.1) (preorder hT xc2.1)) →
List.Pairwise (fun xc1 xc2 : {c : V // c ∈ children p r u} =>
List.Disjoint (preorder hT xc1.1) (preorder hT xc2.1)) cs := by
intro cs
induction cs with
| nil => simp
| cons xc rest ih =>
intro hnd hdisj
rw [List.pairwise_cons]
constructor
· intro a' ha'
apply hdisj xc (by simp) a' (List.mem_cons.mpr (Or.inr ha'))
intro hxc
have hxc_rest : xc ∈ rest := by simpa [hxc] using ha'
exact (List.nodup_cons.mp hnd).1 hxc_rest
· apply ih (List.nodup_cons.mp hnd).2
intro xc1 h1 xc2 h2 hne
exact hdisj xc1 (by simp [h1]) xc2 (by simp [h2]) hneThe preorder of any subtree has no duplicate vertices.
lemma preorder_nodup (hT : TreeOn p r) (v : V) : List.Nodup (preorder hT v) := by
classical
let R : V → V → Prop := fun a b => Fintype.card V - depth p r a < Fintype.card V - depth p r b
have hwf : WellFounded R := (measure (fun a : V => Fintype.card V - depth p r a)).wf
refine hwf.induction (C := fun u : V => List.Nodup (preorder hT u)) v ?_
intro u hrec
rw [preorder_fix hT u]
rw [List.nodup_cons]
constructor
· intro hu
rw [List.mem_flatMap] at hu
rcases hu with ⟨yc, hyc, hupre⟩
have husub : u ∈ subtree p r yc.1 := (preorder_mem_subtree hT yc.1 u).1 hupre
exact v_not_mem_child_subtree hT yc.2 husub
· rw [List.nodup_flatMap]
constructor
· intro xc hxc
exact hrec xc.1 (children_depth_lt hT xc.2)
· have hndlist : List.Nodup ((children p r u).attach.toList) := by
exact Finset.nodup_toList (children p r u).attach
have hdisj : ∀ xc1 ∈ (children p r u).attach.toList, ∀ xc2 ∈ (children p r u).attach.toList,
xc1 ≠ xc2 → List.Disjoint (preorder hT xc1.1) (preorder hT xc2.1) := by
intro xc1 h1 xc2 h2 hne
have hne' : xc1.1 ≠ xc2.1 := by
intro hval
exact hne (Subtype.ext hval)
exact preorder_disjoint_of_ne hT xc1.2 xc2.2 hne'
exact pairwise_disjoint_of_nodup hT u ((children p r u).attach.toList) hndlist hdisjThe preorder tour has no repeated vertices.
lemma dfsTour_nodup (hT : TreeOn p r) : List.Nodup (dfsTour hT) := by
change List.Nodup (preorder hT r)
exact preorder_nodup hT rLemma (isTour). The preorder tour visits every vertex exactly once: it has no duplicates and every vertex appears in it.
lemma dfsTour_isTour (hT : TreeOn p r) :
List.Nodup (dfsTour hT) ∧ ∀ x : V, x ∈ dfsTour hT := by
exact ⟨dfsTour_nodup hT, dfsTour_mem hT⟩The preorder of any subtree is nonempty.
lemma preorder_ne_nil (hT : TreeOn p r) (v : V) : preorder hT v ≠ [] := by
rw [preorder_fix hT v]
simp
The last vertex of the preorder of v.
noncomputable def preorderLast (hT : TreeOn p r) (v : V) : V :=
(preorder hT v).getLast (preorder_ne_nil hT v)
The preorder of v starts at v.
lemma preorder_head (hT : TreeOn p r) (v : V) :
(preorder hT v).head (preorder_ne_nil hT v) = v := by
let L := (children p r v).attach.toList.flatMap (fun xc : {c : V // c ∈ children p r v} => preorder hT xc.1)
have hfix : preorder hT v = v :: L := preorder_fix hT v
have hneL : v :: L ≠ [] := by simp
calc
(preorder hT v).head (preorder_ne_nil hT v) = (v :: L).head hneL := head_eq_of_eq hfix (preorder_ne_nil hT v) hneL
_ = v := rfl
The last vertex of the concatenation of the children preorders, or u if
there are no children (equivalently: the last vertex of [u] followed by the
children preorders).
noncomputable def tailLast (hT : TreeOn p r) (u : V)
(cs : List {c : V // c ∈ children p r u}) : V :=
if h : cs.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1) = [] then u
else (cs.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)).getLast hThe last vertex of the children preorders is unchanged when prepending a child (a nonempty tail still determines the last vertex).
lemma tailLast_cons (hT : TreeOn p r) {u : V} (xc : {c : V // c ∈ children p r u})
(rest : List {c : V // c ∈ children p r u}) (hrest : rest ≠ []) :
tailLast hT u (xc :: rest) = tailLast hT u rest := by
unfold tailLast
have hne : (xc :: rest).flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1) ≠ [] := by
intro h
exact (preorder_ne_nil hT xc.1) (by simpa using (List.append_eq_nil_iff.mp h).1)
have hneRest : rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1) ≠ [] :=
flatMap_append_ne_nil (fun xc => preorder_ne_nil hT xc.1) rest hrest
rw [dif_neg hne, dif_neg hneRest]
have heq : (xc :: rest).flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)
= preorder hT xc.1 ++ rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1) := by
rfl
have hne' : preorder hT xc.1 ++ rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1) ≠ [] := by
intro h
exact (preorder_ne_nil hT xc.1) (by simpa using (List.append_eq_nil_iff.mp h).1)
calc
((xc :: rest).flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)).getLast hne
= (preorder hT xc.1 ++ rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)).getLast hne' :=
getLast_eq_of_eq heq hne hne'
_ = (rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)).getLast hneRest :=
getLast_append_of_right_ne_nil' (preorder hT xc.1)
(rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)) hne' hneRest
The cost of a path starting with u decomposes into the cost of the tail plus the first edge.
lemma pathCost_singleton_append (w : Graph V) (u : V) {l : List V} (h : l ≠ []) :
pathCost w ([u] ++ l) = pathCost w l + w u (l.head h) := by
rw [pathCost_append_nonempty w (by simp) h]
simp [pathCost]
Shortcut (children list). The preorder path through a list of children
closed to a target t costs no more than the sum over the children of their
preorder costs plus the edges to and from u, plus the closing edge u → t.
Each inter-child edge is charged to a two-hop path through u by the triangle
inequality.
lemma preorder_cycle_aux (hT : TreeOn p r) (w : Graph V)
(hTri : ∀ a b c : V, w a c ≤ w a b + w b c) {u : V} (t : V)
(cs : List {c : V // c ∈ children p r u}) :
pathCost w ([u] ++ cs.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)) + w (tailLast hT u cs) t
≤ (cs.map (fun xc : {c : V // c ∈ children p r u} =>
pathCost w (preorder hT xc.1) + w (preorderLast hT xc.1) u + w u xc.1)).sum + w u t := by
induction cs with
| nil =>
simp [tailLast, pathCost]
| cons xc rest ih =>
by_cases hre : rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1) = []
· have hrest_nil : rest = [] := by
by_contra hrn
have hne' : rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1) ≠ [] :=
flatMap_append_ne_nil (fun xc => preorder_ne_nil hT xc.1) rest hrn
exact hne' hre
subst hrest_nil
have hc : pathCost w ([u] ++ preorder hT xc.1) = pathCost w (preorder hT xc.1) + w u xc.1 := by
rw [pathCost_append_nonempty w (by simp) (preorder_ne_nil hT xc.1)]
simp [pathCost, preorder_head hT xc.1]
have hflat : [xc].flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1) = preorder hT xc.1 := by
simp
have htl1 : tailLast hT u [xc] = preorderLast hT xc.1 := by
unfold tailLast
rw [hflat]
rw [dif_neg (preorder_ne_nil hT xc.1)]
rfl
rw [hflat]
rw [hc]
rw [htl1]
simp
have htri := hTri (preorderLast hT xc.1) u t
omega
· have hRne : rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1) ≠ [] := hre
have hrest_ne : rest ≠ [] := by
intro hr
subst hr
simp at hre
have htl : tailLast hT u (xc :: rest) = tailLast hT u rest := tailLast_cons hT xc rest hrest_ne
rw [List.flatMap_cons]
rw [htl]
rw [← List.append_assoc]
have hne1 : [u] ++ preorder hT xc.1 ≠ [] := by simp
have hgl : ([u] ++ preorder hT xc.1).getLast hne1 = preorderLast hT xc.1 := by
unfold preorderLast
rw [getLast_append_of_right_ne_nil' [u] (preorder hT xc.1) hne1 (preorder_ne_nil hT xc.1)]
have h1 : pathCost w (([u] ++ preorder hT xc.1) ++ rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1))
= pathCost w (preorder hT xc.1) + w u xc.1 + pathCost w (rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1))
+ w (preorderLast hT xc.1) ((rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)).head hRne) := by
rw [pathCost_append_nonempty w hne1 hRne]
rw [pathCost_singleton_append w u (preorder_ne_nil hT xc.1)]
rw [preorder_head hT xc.1]
rw [hgl]
rw [h1]
rw [List.map_cons, List.sum_cons]
have htri := hTri (preorderLast hT xc.1) u ((rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)).head hRne)
have h2 : pathCost w (rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1))
+ w u ((rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)).head hRne)
= pathCost w ([u] ++ rest.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)) :=
(pathCost_singleton_append w u hRne).symm
nlinarith
Shortcut (per vertex). The preorder path of u closed to t costs
no more than the sum over the children of their preorder costs plus the edges
to and from u, plus the closing edge u → t.
-- Instantiate preorder_cycle_aux at the full children list: the last vertex of
-- `[u]` followed by all children preorders is `preorderLast u`.
lemma preorder_cycle_le_sum (hT : TreeOn p r) (w : Graph V)
(hTri : ∀ a b c : V, w a c ≤ w a b + w b c) (u : V) (t : V) :
pathCost w (preorder hT u) + w (preorderLast hT u) t
≤ ((children p r u).attach.toList.map (fun xc : {c : V // c ∈ children p r u} =>
pathCost w (preorder hT xc.1) + w (preorderLast hT xc.1) u + w u xc.1)).sum + w u t := by
let cs := (children p r u).attach.toList
have haux := preorder_cycle_aux hT w hTri t cs
have hfix' : preorder hT u = u :: cs.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1) := by
simpa [cs] using preorder_fix hT u
have hpath : pathCost w ([u] ++ cs.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)) = pathCost w (preorder hT u) := by
rw [hfix']
rfl
have htl : tailLast hT u cs = preorderLast hT u := by
unfold tailLast preorderLast
by_cases hcs : cs.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1) = []
· rw [dif_pos hcs]
have hsingle : preorder hT u = [u] := by
rw [hfix', hcs]
have hne1 : [u] ≠ [] := by simp
symm
calc
(preorder hT u).getLast (preorder_ne_nil hT u) = [u].getLast hne1 := getLast_eq_of_eq hsingle (preorder_ne_nil hT u) hne1
_ = u := rfl
· rw [dif_neg hcs]
have heq : preorder hT u = [u] ++ cs.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1) := by
rw [hfix']
rfl
have hneApp : [u] ++ cs.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1) ≠ [] := by simp
symm
calc
(preorder hT u).getLast (preorder_ne_nil hT u)
= ([u] ++ cs.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)).getLast hneApp :=
getLast_eq_of_eq heq (preorder_ne_nil hT u) hneApp
_ = (cs.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)).getLast hcs :=
getLast_append_of_right_ne_nil' [u] (cs.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)) hneApp hcs
-- assemble
calc
pathCost w (preorder hT u) + w (preorderLast hT u) t
= pathCost w ([u] ++ cs.flatMap (fun xc : {c : V // c ∈ children p r u} => preorder hT xc.1)) + w (tailLast hT u cs) t := by
rw [hpath, htl]
_ ≤ (cs.map (fun xc : {c : V // c ∈ children p r u} =>
pathCost w (preorder hT xc.1) + w (preorderLast hT xc.1) u + w u xc.1)).sum + w u t := haux
_ = ((children p r u).attach.toList.map (fun xc : {c : V // c ∈ children p r u} =>
pathCost w (preorder hT xc.1) + w (preorderLast hT xc.1) u + w u xc.1)).sum + w u t := by simp [cs]
Shortcut bound (per subtree). For every subtree v and any target t,
the preorder path of v closed to t costs no more than the walk of v plus
the edge v → t. Proved by well-founded induction on the subtree, with the
target universally quantified so that inter-child charging can re-target.
lemma preorder_bound (hT : TreeOn p r) (w : Graph V)
(hTri : ∀ a b c : V, w a c ≤ w a b + w b c) (t : V) (v : V) :
pathCost w (preorder hT v) + w (preorderLast hT v) t ≤ pathCost w (dfsWalkFrom hT v) + w v t := by
classical
let R : V → V → Prop := fun a b => Fintype.card V - depth p r a < Fintype.card V - depth p r b
have hwf : WellFounded R := (measure (fun a : V => Fintype.card V - depth p r a)).wf
have hall : ∀ u : V, ∀ t : V,
pathCost w (preorder hT u) + w (preorderLast hT u) t ≤ pathCost w (dfsWalkFrom hT u) + w u t := by
intro u
refine hwf.induction (C := fun u : V => ∀ t : V,
pathCost w (preorder hT u) + w (preorderLast hT u) t ≤ pathCost w (dfsWalkFrom hT u) + w u t) u ?_
intro u hrec t
have h1 := preorder_cycle_le_sum hT w hTri u t
have h2 : ((children p r u).attach.toList.map (fun xc : {c : V // c ∈ children p r u} =>
pathCost w (preorder hT xc.1) + w (preorderLast hT xc.1) u + w u xc.1)).sum
≤ ((children p r u).attach.toList.map (fun xc : {c : V // c ∈ children p r u} =>
pathCost w (dfsWalkFrom hT xc.1) + w xc.1 u + w u xc.1)).sum := by
apply List.sum_le_sum
intro xc hxc
have hrec' := hrec xc.1 (children_depth_lt hT xc.2) u
exact Nat.add_le_add_right hrec' (w u xc.1)
have h3 : ((children p r u).attach.toList.map (fun xc : {c : V // c ∈ children p r u} =>
pathCost w (dfsWalkFrom hT xc.1) + w xc.1 u + w u xc.1)).sum = pathCost w (dfsWalkFrom hT u) := by
simpa [walkCost] using (dfsWalkFrom_cost_rec hT w u).symm
calc
pathCost w (preorder hT u) + w (preorderLast hT u) t
≤ ((children p r u).attach.toList.map (fun xc : {c : V // c ∈ children p r u} =>
pathCost w (preorder hT xc.1) + w (preorderLast hT xc.1) u + w u xc.1)).sum + w u t := h1
_ ≤ ((children p r u).attach.toList.map (fun xc : {c : V // c ∈ children p r u} =>
pathCost w (dfsWalkFrom hT xc.1) + w xc.1 u + w u xc.1)).sum + w u t := Nat.add_le_add_right h2 (w u t)
_ = pathCost w (dfsWalkFrom hT u) + w u t := by rw [h3]
exact hall v tThe preorder tour is nonempty.
lemma dfsTour_ne_nil (hT : TreeOn p r) : dfsTour hT ≠ [] := by
change preorder hT r ≠ []
exact preorder_ne_nil hT rThe preorder tour starts at the root.
lemma dfsTour_head (hT : TreeOn p r) : (dfsTour hT).head (dfsTour_ne_nil hT) = r := by
change (preorder hT r).head (preorder_ne_nil hT r) = r
exact preorder_head hT rThe last vertex of the preorder tour.
lemma dfsTour_last (hT : TreeOn p r) : (dfsTour hT).getLast (dfsTour_ne_nil hT) = preorderLast hT r := by
change (preorder hT r).getLast (preorder_ne_nil hT r) = preorderLast hT r
rfl
Lemma (shortcut). The tour obtained by shortcutting the depth-first walk —
the preorder list read as a cycle — costs no more than the walk itself. This is
the triangle-inequality step of APPROX-TSP-TOUR: every skipped return is charged
to a two-hop path through the tree, and w v v = 0 closes the leaf-root case.
lemma dfsTour_bound (hT : TreeOn p r) (w : Graph V)
(hTri : ∀ a b c : V, w a c ≤ w a b + w b c)
(hLoop : ∀ v : V, w v v = 0) :
tourCostTo w ((dfsTour hT).head (dfsTour_ne_nil hT)) (dfsTour hT) ≤ walkCost w (dfsWalk hT) := by
have hG := preorder_bound hT w hTri r r
unfold tourCostTo
rw [dfsTour_head hT]
have hne : dfsTour hT ≠ [] := dfsTour_ne_nil hT
simp [hne]
rw [dfsTour_last hT]
have hG' : pathCost w (dfsTour hT) + w (preorderLast hT r) r ≤ walkCost w (dfsWalk hT) + w r r := by
simpa [dfsTour, dfsWalk, walkCost] using hG
have hloop := hLoop r
calc
pathCost w (dfsTour hT) + w (preorderLast hT r) r ≤ walkCost w (dfsWalk hT) + w r r := hG'
_ = walkCost w (dfsWalk hT) := by simp [hloop]Theorem 35.2. APPROX-TSP-TOUR returns a tour whose cost is at most twice the cost of any tour — in particular, of an optimal one.
Indeed, the preorder tour costs no more than the depth-first walk (Lemma
dfsTour_bound), the walk costs exactly twice the tree (Lemma 35.2,
dfsWalk_cost), and a minimum spanning tree costs no more than any tour (Lemma
35.3, mst_le_tour).
theorem tsp_two_approx {w : Graph V} {p : V → V} {r : V}
(hMST : IsMinimumSpanningTreeOn w p r)
(hSymm : ∀ x y : V, w x y = w y x)
(hTri : ∀ a b c : V, w a c ≤ w a b + w b c)
(hLoop : ∀ v : V, w v v = 0)
{σ : V → V} (hT : Tour σ) :
tourCostTo w ((dfsTour hMST.1).head (dfsTour_ne_nil hMST.1)) (dfsTour hMST.1) ≤ 2 * TourCost w σ := by
have h1 := dfsTour_bound hMST.1 w hTri hLoop
have h2 := dfsWalk_cost hMST.1 w hSymm
have h3 := mst_le_tour hMST hT
calc
tourCostTo w ((dfsTour hMST.1).head (dfsTour_ne_nil hMST.1)) (dfsTour hMST.1) ≤ walkCost w (dfsWalk hMST.1) := h1
_ = 2 * treeCost w p r := h2
_ ≤ 2 * TourCost w σ := by exact Nat.mul_le_mul_left 2 h3end TreeOnend TSPend CLRSDefinitions and proofs
CLRSLean.FourthEdition.Chapter_35.Section_35_2_The_Traveling_Salesperson_Problem.GraphExecution
Metric TSP starting from a weighted complete graph
Chapter 21's verified Prim execution constructs an edge MST. Shortest-path rooting converts its selected edges into a parent tree without increasing weight. Conversely, each competing parent tree gives a connected edge set; Kruskal extracts a spanning tree of no greater weight. This discharges the minimum-parent-tree premise of the existing DFS approximation theorem.
Only the weights, root, symmetry, triangle inequality and zero-loop conditions are inputs. Neither a final MST certificate nor a representation adapter is supplied by the caller. Rooting and exact component queries are classical; there is no polynomial runtime claim for this composition.
noncomputable sectionnamespace CLRS.TSP.GraphAdapteropen Finset Classical MST MST.ExecutablePrimvariable {n : Nat}local instance : LinearOrder (Fin n × Fin n) :=
LinearOrder.lift' (Fintype.equivFin (Fin n × Fin n)) (Fintype.equivFin _).injectivelocal instance : DecidableEq (Fin n × Fin n) :=
(inferInstance : LinearOrder (Fin n × Fin n)).toDecidableEqThe complete graph represents an undirected connection by ordered endpoint labels.
def complete : FiniteGraph (Fin n) (Fin n × Fin n) where
src := Prod.fst
dst := Prod.snd
vertices := univ
edges := univ
src_mem _ _ := mem_univ _
dst_mem _ _ := mem_univ _theorem complete_connected : (complete (n:=n)).Spans complete.edges := by
intro u _ v _
exact Graph.connected_of_mem_edge (e := (u,v)) (mem_univ _)def selected (w : TSP.Graph (Fin n)) (r : Fin n) : Finset (Fin n × Fin n) :=
prim (frontierRun (complete (n:=n)) (components (complete (n:=n)).toGraph) (fun e : Fin n × Fin n => w e.1 e.2) r
(by intro A e h; exact (show e ∈ (complete (n:=n)).edges from mem_univ e)) n ∅) ∅theorem selected_mst (w : TSP.Graph (Fin n)) (r : Fin n) :
complete.IsMinimumSpanningTree (fun e : Fin n × Fin n => w e.1 e.2) (selected w r) := by
simpa [selected,complete] using frontierRun_minimum_spanning_tree_of_card
(complete (n:=n)) (components (complete (n:=n)).toGraph) (fun e : Fin n × Fin n => w e.1 e.2) r
(by intro A e h; exact (show e ∈ (complete (n:=n)).edges from mem_univ e)) (components_exact _) (mem_univ r) complete_connectedtheorem selectedConnected (w : TSP.Graph (Fin n)) (r : Fin n) :
ConnectedSelection complete.toGraph (selected w r) r where
reaches v := (selected_mst w r).1.2.1 r (mem_univ _) v (mem_univ _)The parent map is computed from the MST selected by the actual Prim recursion.
def mstParent (w : TSP.Graph (Fin n)) (r : Fin n) : Fin n → Fin n :=
parent (selectedConnected w r)theorem mstParent_tree (w : TSP.Graph (Fin n)) (r : Fin n) : TreeOn (mstParent w r) r :=
parent_tree (selectedConnected w r)def parentEdges (p : Fin n → Fin n) (r : Fin n) : Finset (Fin n × Fin n) :=
(univ.erase r).image (fun v => (v,p v))
theorem parentEdges_weight (w : TSP.Graph (Fin n)) (p : Fin n → Fin n) (r : Fin n) :
MST.weight (fun e : Fin n × Fin n => w e.1 e.2) (parentEdges p r) = treeCost w p r := by
unfold MST.weight parentEdges treeCost
rw [sum_image]
intro u hu v hv he
exact congrArg Prod.fst he
theorem parentEdges_spans {p : Fin n → Fin n} {r : Fin n} (h : TreeOn p r) :
complete.Spans (parentEdges p r) := by
have hedge (v : Fin n) : complete.toGraph.ConnectedIn (parentEdges p r) v (p v) := by
by_cases hv : v=r
· subst v
rw [h.root_fixed]
exact Graph.connected_refl _ _ _
· exact Graph.connected_of_mem_edge (e:=(v,p v))
(mem_image.mpr ⟨v,mem_erase.mpr ⟨hv,mem_univ _⟩,rfl⟩)
have hiter (k : Nat) (v : Fin n) :
complete.toGraph.ConnectedIn (parentEdges p r) v (p^[k] v) := by
induction k generalizing v with
| zero => exact Graph.connected_refl _ _ _
| succ k ih =>
rw [Function.iterate_succ_apply]
exact Graph.connected_trans (hedge v) (ih (p v))
have hroot (v : Fin n) : complete.toGraph.ConnectedIn (parentEdges p r) v r := by
obtain ⟨k,hk⟩ := h.reaches_root v
simpa [hk] using hiter k v
intro u _ v _
exact Graph.connected_trans (hroot u) (Graph.connected_symm (hroot v))The edge MST compares with any connected edge set, including one with cycles.
theorem selected_le_connected (w : TSP.Graph (Fin n)) (r : Fin n)
(B : Finset (Fin n × Fin n)) (hB : complete.Spans B) :
MST.weight (fun e : Fin n × Fin n => w e.1 e.2) (selected w r) ≤ MST.weight (fun e : Fin n × Fin n => w e.1 e.2) B := by
let H : FiniteGraph (Fin n) (Fin n × Fin n) :=
{ complete with
edges := B
src_mem := by intros; exact mem_univ _
dst_mem := by intros; exact mem_univ _ }
let K := kruskal (acceptByComponent H.toGraph (components H.toGraph)) B.toList ∅
have hK : H.IsSpanningTree K := H.kruskal_spanning_tree_of_complete_exact_component
(components H.toGraph) (components_exact _) B.toList (by simp)
(by intro e he; exact mem_toList.mp he) (by intro e he; exact mem_toList.mpr he)
hB H.isForest_empty
have hK' : complete.IsSpanningTree K := ⟨by intro e he; exact mem_univ e,hK.2⟩
exact le_trans ((selected_mst w r).2 K hK') (sum_le_sum_of_subset hK.1)Concrete edge-to-parent composition discharges the old minimum-tree premise.
theorem mstParent_minimum (w : TSP.Graph (Fin n)) (r : Fin n)
(hSymm : ∀ u v, w u v = w v u) : IsMinimumSpanningTreeOn w (mstParent w r) r := by
refine ⟨mstParent_tree w r,?_⟩
intro p r' hp
calc
treeCost w (mstParent w r) r ≤ MST.weight (fun e : Fin n × Fin n => w e.1 e.2) (selected w r) :=
parent_cost_le (selectedConnected w r) w hSymm
_ ≤ MST.weight (fun e : Fin n × Fin n => w e.1 e.2) (parentEdges p r') :=
selected_le_connected w r _ (parentEdges_spans hp)
_ = treeCost w p r' := parentEdges_weight w p r'The actual returned preorder, rooted from the actual Prim-selected edge set.
def graphTour (w : TSP.Graph (Fin n)) (r : Fin n) : List (Fin n) :=
TreeOn.dfsTour (mstParent_tree w r)theorem graphTour_nodup (w : TSP.Graph (Fin n)) (r : Fin n) : (graphTour w r).Nodup :=
TreeOn.dfsTour_nodup (mstParent_tree w r)theorem graphTour_mem (w : TSP.Graph (Fin n)) (r v : Fin n) : v ∈ graphTour w r :=
TreeOn.dfsTour_mem (mstParent_tree w r) v
theorem graphTour_length (w : TSP.Graph (Fin n)) (r : Fin n) : (graphTour w r).length = n := by
have heq : (graphTour w r).toFinset = univ := by
ext v
simp [graphTour_mem]
have hc := congrArg Finset.card heq
simpa [List.toFinset_card_of_nodup (graphTour_nodup w r)] using hctheorem graphTour_two_approx (w : TSP.Graph (Fin n)) (r : Fin n)
(hSymm : ∀ u v, w u v = w v u)
(hTri : ∀ a b c, w a c ≤ w a b + w b c)
(hLoop : ∀ v, w v v = 0)
{σ : Fin n → Fin n} (hTour : Tour σ) :
tourCostTo w r (graphTour w r) ≤ 2*TourCost w σ := by
have ht := TreeOn.tsp_two_approx (mstParent_minimum w r hSymm) hSymm hTri hLoop hTour
simpa [graphTour,TreeOn.dfsTour_head] using htend CLRS.TSP.GraphAdapterCLRSLean.FourthEdition.Chapter_35.Section_35_2_The_Traveling_Salesperson_Problem.Rooting
Rooting a selected connected edge set
Shortest unweighted root-path distances select strictly decreasing parents. Every non-root vertex is assigned a selected edge, and these assignments are injective: opposite uses of one edge would contradict strict depth decrease. Thus rooting costs no more than the supplied selected edge set. The choice of shortest predecessors is classical; this module makes no running-time claim.
noncomputable sectionnamespace CLRS.TSP.GraphAdapteropen Finset Classicalvariable {V E : Type} [Fintype V] [DecidableEq V] [DecidableEq E]The exact finite component interface, constructed from graph connectivity.
def components (G : MST.Graph V E) : MST.ComponentOracle G where
component A root := univ.filter (G.ConnectedIn A root)
mem_self A v := by simp [MST.Graph.connected_refl]
closed_src A root e he hs := by
simp only [mem_filter,mem_univ,true_and] at *
exact MST.Graph.connected_trans hs (MST.Graph.connected_of_mem_edge he)
closed_dst A root e he hs := by
simp only [mem_filter,mem_univ,true_and] at *
exact MST.Graph.connected_trans hs (MST.Graph.connected_symm (MST.Graph.connected_of_mem_edge he))omit [DecidableEq V] [DecidableEq E] in
theorem components_exact (G : MST.Graph V E) : MST.ExactComponentOracle G (components G) := by
intro A root v
simp [components]inductive Hops (G : MST.Graph V E) (A : Finset E) (root : V) : Nat → V → Prop
| root : Hops G A root 0 root
| step {d u v} : Hops G A root d u → G.AdjIn A u v → Hops G A root (d+1) vomit [Fintype V] [DecidableEq V] [DecidableEq E] in
private theorem hops_exists {G : MST.Graph V E} {A : Finset E} {r v : V}
(h : G.ConnectedIn A r v) : ∃ d, Hops G A r d v := by
induction h with
| refl => exact ⟨0,.root⟩
| tail _ he ih => obtain ⟨d,hd⟩ := ih; exact ⟨d+1,.step hd he⟩structure ConnectedSelection (G : MST.Graph V E) (A : Finset E) (r : V) : Prop where
reaches : ∀ v, G.ConnectedIn A r vvariable {G : MST.Graph V E} {A : Finset E} {r : V}def depth (h : ConnectedSelection G A r) (v : V) : Nat := Nat.find (hops_exists (h.reaches v))theorem depth_spec (h : ConnectedSelection G A r) (v : V) : Hops G A r (depth h v) v :=
Nat.find_spec (hops_exists (h.reaches v))theorem depth_le (h : ConnectedSelection G A r) {d : Nat} {v : V} (hd : Hops G A r d v) :
depth h v ≤ d := Nat.find_min' _ hd@[simp] theorem depth_root (h : ConnectedSelection G A r) : depth h r = 0 :=
Nat.eq_zero_of_le_zero (depth_le h Hops.root)theorem predecessor_exists (h : ConnectedSelection G A r) {v : V} (hv : v ≠ r) :
∃ u e, e ∈ A ∧ ((G.src e = v ∧ G.dst e = u) ∨ (G.src e = u ∧ G.dst e = v)) ∧
depth h u < depth h v := by
have hp := depth_spec h v
generalize hd : depth h v = d at hp
cases hp with
| root => exact (hv rfl).elim
| @step d u v hp he =>
obtain ⟨e,he,hor⟩ := he
exact ⟨u,e,he,hor.symm,by have := depth_le h hp; omega⟩def parent (h : ConnectedSelection G A r) (v : V) : V :=
if hv : v=r then r else (predecessor_exists h hv).choosedef parentEdge (h : ConnectedSelection G A r) (v : V) (hv : v ≠ r) : E :=
((predecessor_exists h hv).choose_spec).choosetheorem parent_spec (h : ConnectedSelection G A r) (v : V) (hv : v ≠ r) :
parentEdge h v hv ∈ A ∧
((G.src (parentEdge h v hv)=v ∧ G.dst (parentEdge h v hv)=parent h v) ∨
(G.src (parentEdge h v hv)=parent h v ∧ G.dst (parentEdge h v hv)=v)) ∧
depth h (parent h v) < depth h v := by
simpa [parent,parentEdge,hv] using ((predecessor_exists h hv).choose_spec).choose_spec@[simp] theorem parent_root (h : ConnectedSelection G A r) : parent h r = r := by simp [parent]
theorem parent_tree (h : ConnectedSelection G A r) : TreeOn (parent h) r := by
refine ⟨parent_root h,?_⟩
intro v
induction hv : depth h v using Nat.strong_induction_on generalizing v with
| h d ih =>
by_cases hvr : v=r
· exact ⟨0,hvr⟩
· obtain ⟨k,hk⟩ := ih (depth h (parent h v)) (by simpa [hv] using (parent_spec h v hvr).2.2)
(parent h v) rfl
exact ⟨k+1,by simpa only [Function.iterate_succ_apply] using hk⟩
theorem parentEdge_injective (h : ConnectedSelection G A r) {u v : V}
(hu : u ≠ r) (hv : v ≠ r) (he : parentEdge h u hu = parentEdge h v hv) : u=v := by
obtain ⟨_,hue,hud⟩ := parent_spec h u hu
obtain ⟨_,hve,hvd⟩ := parent_spec h v hv
rw [he] at hue
rcases hue with hu' | hu' <;> rcases hve with hv' | hv'
· exact hu'.1.symm.trans hv'.1
· have huv : u = parent h v := hu'.1.symm.trans hv'.1
have hvu : v = parent h u := hv'.2.symm.trans hu'.2
have hdu := congrArg (depth h) huv
have hdv := congrArg (depth h) hvu
omega
· have huv : u = parent h v := hu'.2.symm.trans hv'.2
have hvu : v = parent h u := hv'.1.symm.trans hu'.1
have hdu := congrArg (depth h) huv
have hdv := congrArg (depth h) hvu
omega
· exact hu'.2.symm.trans hv'.2Parent maintenance assigns distinct selected edges; nonnegative weights suffice.
theorem parent_cost_le (h : ConnectedSelection G A r) (w : TSP.Graph V)
(hSymm : ∀ u v, w u v = w v u) :
treeCost w (parent h) r ≤ MST.weight (fun e => w (G.src e) (G.dst e)) A := by
classical
by_cases hA : A.Nonempty
· let f : V → E := fun v => if hv : v ≠ r then parentEdge h v hv else hA.choose
have hf : ∀ v ∈ univ.erase r, f v ∈ A := by
intro v hv
simpa [f,(mem_erase.mp hv).1] using (parent_spec h v (mem_erase.mp hv).1).1
have hinj : Set.InjOn f (univ.erase r : Finset V) := by
intro u hu v hv he
apply parentEdge_injective h (mem_erase.mp hu).1 (mem_erase.mp hv).1
simpa [f,(mem_erase.mp hu).1,(mem_erase.mp hv).1] using he
calc
treeCost w (parent h) r = ∑ v ∈ univ.erase r, w (G.src (f v)) (G.dst (f v)) := by
apply sum_congr rfl
intro v hv
have hn := (mem_erase.mp hv).1
obtain ⟨_,hor,_⟩ := parent_spec h v hn
rcases hor with hor | hor
· simp [f,hn,hor.1,hor.2]
· simp [f,hn,hor.1,hor.2,hSymm]
_ = ∑ e ∈ (univ.erase r).image f, w (G.src e) (G.dst e) := (sum_image (f := fun e => w (G.src e) (G.dst e)) hinj).symm
_ ≤ MST.weight (fun e => w (G.src e) (G.dst e)) A := by
apply sum_le_sum_of_subset
intro e he
obtain ⟨v,hv,rfl⟩ := mem_image.mp he
exact hf v hv
· have hzero : univ.erase r = (∅ : Finset V) := by
apply eq_empty_iff_forall_notMem.mpr
intro v hv
exact hA ⟨parentEdge h v (mem_erase.mp hv).1,(parent_spec h v (mem_erase.mp hv).1).1⟩
simp [treeCost,hzero]end CLRS.TSP.GraphAdapterImports
import Mathlib35.3. The Set-Covering Problem
The returned-family refinement connects the executable family to the proved approximation bounds.
This section formalizes the set-covering problem and the harmonic
approximation guarantee of the greedy algorithm GREEDY-SET-COVER from CLRS
§35.3. Given a finite universe X and a family F of subsets of X whose
union is X, a set cover is a subfamily C ⊆ F whose union is X, and the
problem is to find a set cover of minimum cardinality. Computing an optimal
cover is NP-hard, but GREEDY-SET-COVER — which repeatedly picks the set of F
covering the most still-uncovered elements and removes the elements it covers —
always finds a cover within a factor H(d) of the optimum, where d bounds
the sizes of the sets in F and H is the harmonic number (Theorem 35.3).
Main results:
-
Definition
Covers: a family of sets covering a universe. -
Definition
pickSet: the greedy pick — a set ofFcovering at least as many uncovered elements as any other. -
Definition
greedySetCover: the family of sets returned by GREEDY-SET-COVER. -
Definition
greedyCost: the number of sets GREEDY-SET-COVER picks. -
Theorem
greedySetCover_covers(Theorem 35.3, correctness): the returned family covers its universe. -
Theorem
greedySetCover_subset: the returned family is drawn fromF. -
Theorem
greedySetCover_approx(Theorem 35.3): for every coverCofX,greedyCost ≤ H(d) · |C|— in particular,Cmay be an optimal cover. -
Theorem
greedySetCover_ln_approx(Theorem 35.4): for every coverCofX,greedyCost ≤ |C| · (⌈ln |X|⌉ + 1)— GREEDY-SET-COVER is anO(lg |X|)-approximation algorithm.
The approximation proof is the CLRS charging argument. Each greedy step charges
1 / |new| to every element covered at that step, where new is the set of
elements the greedy pick covers (chargeSum). The total charge is exactly the
cost, and — because the greedy pick covers at least as many uncovered elements
as any set of F — the charge accrued by the elements of any fixed set S is
at most H(|S|) (Lemma chargeSum_le_harmonic). Summing these bounds over a
cover C and using |S| ≤ d gives the H(d)-approximation (Theorem 35.3).
Theorem 35.4's logarithmic bound uses a different argument: a size-k cover of
the current uncovered set U forces the greedy pick to cover at least |U| / k
elements, so the uncovered set shrinks by the factor (1 - 1/k) each step
(pickSet_sdiff_shrink). Iterating, after k · ⌈ln |X|⌉ steps the uncovered
set has size below 1 (greedyCost_le_fuel with 1 - 1/k ≤ e^{-1/k}), giving
greedyCost ≤ |C| · (⌈ln |X|⌉ + 1).
Notation conventions used in this section:
-
X: the universe -
F: the family of subsets available to the greedy algorithm -
U: the current set of still-uncovered elements -
A: a set of elements whose charge is accumulated -
C: a candidate set cover (a subfamily ofF) -
d: a bound on the sizes of the sets inF -
H(n): then-th harmonic numberharmonic n
noncomputable sectionopen Finsetopen scoped BigOperatorsnamespace CLRSnamespace SetCovervariable {α : Type} [DecidableEq α]
A family C of sets covers X when every element of X lies in some
set of C. This is the set-cover feasibility condition of CLRS §35.3.
def Covers (X : Finset α) (C : Finset (Finset α)) : Prop :=
∀ x ∈ X, ∃ S ∈ C, x ∈ S
Some set of F maximizes the number of uncovered elements it covers.
lemma exists_max_coverage (F : Finset (Finset α)) (U : Finset α) (hF : F.Nonempty) :
∃ S ∈ F, ∀ T ∈ F, (T ∩ U).card ≤ (S ∩ U).card := by
classical
obtain ⟨S, hS, hmax⟩ := Finset.exists_max_image F (fun S : Finset α => (S ∩ U).card) hF
exact ⟨S, hS, by intro T hT; exact hmax T hT⟩
The greedy pick: a set of F covering as many uncovered elements as any
other set of F (CLRS §35.3, GREEDY-SET-COVER).
noncomputable def pickSet (F : Finset (Finset α)) (U : Finset α) (hF : F.Nonempty) : Finset α :=
Classical.choose (exists_max_coverage F U hF)
The greedy pick is a member of the family F.
lemma pickSet_mem (F : Finset (Finset α)) (U : Finset α) (hF : F.Nonempty) :
pickSet F U hF ∈ F :=
(Classical.choose_spec (exists_max_coverage F U hF)).1
The greedy pick covers at least as many uncovered elements as any set of
F.
lemma pickSet_coverage_le (F : Finset (Finset α)) (U : Finset α) (hF : F.Nonempty) {T : Finset α}
(hT : T ∈ F) :
(T ∩ U).card ≤ (pickSet F U hF ∩ U).card :=
(Classical.choose_spec (exists_max_coverage F U hF)).2 T hTA covering family of a nonempty universe is itself nonempty.
lemma cover_nonempty (F : Finset (Finset α)) {U : Finset α}
(hcov : ∀ x ∈ U, ∃ S ∈ F, x ∈ S) (hU : U.Nonempty) :
F.Nonempty := by
rcases hU with ⟨x, hx⟩
rcases hcov x hx with ⟨S, hS, _⟩
exact ⟨S, hS⟩The covering property is inherited by subsets of the universe.
lemma cover_sub (F : Finset (Finset α)) {U U' : Finset α}
(hcov : ∀ x ∈ U, ∃ S ∈ F, x ∈ S) (hU' : U' ⊆ U) :
∀ x ∈ U', ∃ S ∈ F, x ∈ S := by
intro x hx
exact hcov x (hU' hx)The greedy pick of a covered nonempty universe covers at least one uncovered element, so the uncovered set strictly shrinks.
lemma pickSet_sdiff_card_lt (F : Finset (Finset α)) {U : Finset α}
(hcov : ∀ x ∈ U, ∃ S ∈ F, x ∈ S) (hU : U.Nonempty) :
(U \ pickSet F U (cover_nonempty F hcov hU)).card < U.card := by
classical
let x := hU.choose
have hxU : x ∈ U := hU.choose_spec
rcases hcov x hxU with ⟨S, hS, hxS⟩
have hmem : x ∈ S ∩ U := Finset.mem_inter.mpr ⟨hxS, hxU⟩
have hScover : 1 ≤ (S ∩ U).card := by
have hpos : 0 < (S ∩ U).card := Finset.card_pos.mpr ⟨x, hmem⟩
omega
have hpick : 1 ≤ (pickSet F U (cover_nonempty F hcov hU) ∩ U).card :=
le_trans hScover (pickSet_coverage_le F U (cover_nonempty F hcov hU) hS)
have hUcard : 1 ≤ U.card := by
have hpos : 0 < U.card := Finset.card_pos.mpr ⟨x, hxU⟩
omega
rw [Finset.card_sdiff]
omega
The harmonic number harmonic is monotone in its argument.
lemma harmonic_mono {a b : ℕ} (h : a ≤ b) : harmonic a ≤ harmonic b := by
induction' h with b hb ih
· rfl
· calc
harmonic a ≤ harmonic b := ih
_ ≤ harmonic (b + 1) := by
rw [harmonic_succ]
exact le_add_of_nonneg_right (by positivity)
The harmonic number harmonic is nonnegative.
lemma harmonic_nonneg (n : ℕ) : 0 ≤ harmonic n := by
induction n with
| zero => simp
| succ n ih =>
rw [harmonic_succ]
exact add_nonneg ih (by positivity)
The difference of harmonic numbers is the sum of reciprocals over the
half-open interval [a, b).
lemma harmonic_sub {a b : ℕ} (h : a ≤ b) :
harmonic b - harmonic a = ∑ i ∈ Finset.Ico a b, (↑(i + 1 : ℕ) : ℚ)⁻¹ := by
rw [harmonic, harmonic]
exact (Finset.sum_Ico_eq_sub (fun i : ℕ => (↑(i + 1 : ℕ) : ℚ)⁻¹) h).symm
The core harmonic charge bound: if a ≤ n ≤ m with n > 0, then the number
(n - a) of interval points contributes at most H(n) - H(a).
lemma harm_bound (a n m : ℕ) (ha : a ≤ n) (hn : 0 < n) (hnm : n ≤ m) :
(((n - a : ℕ) : ℚ) / (m : ℚ)) ≤ harmonic n - harmonic a := by
have hIco : harmonic n - harmonic a = ∑ i ∈ Finset.Ico a n, (↑(i + 1 : ℕ) : ℚ)⁻¹ :=
harmonic_sub ha
have hterm : (∑ i ∈ Finset.Ico a n, (↑(n : ℚ))⁻¹) ≤ ∑ i ∈ Finset.Ico a n, (↑(i + 1 : ℕ) : ℚ)⁻¹ := by
apply Finset.sum_le_sum
intro i hi
rcases Finset.mem_Ico.mp hi with ⟨hai, hin⟩
have hle : (i + 1 : ℕ) ≤ n := by omega
have hip : (0 : ℚ) < ((i + 1 : ℕ) : ℚ) := by positivity
simpa using one_div_le_one_div_of_le (b := (n : ℚ)) hip (by exact_mod_cast hle)
have hconst : (∑ i ∈ Finset.Ico a n, (↑(n : ℚ))⁻¹) = ((n - a : ℕ) : ℚ) * (↑(n : ℚ))⁻¹ := by
rw [Finset.sum_const, Nat.card_Ico a n]
norm_num
have hnm' : ((n - a : ℕ) : ℚ) * (↑(m : ℚ))⁻¹ ≤ ((n - a : ℕ) : ℚ) * (↑(n : ℚ))⁻¹ := by
have hmn : (0 : ℚ) < (m : ℚ) := by exact_mod_cast (lt_of_lt_of_le hn hnm)
have hnp : (0 : ℚ) < (n : ℚ) := by exact_mod_cast hn
have hle : (↑(m : ℚ))⁻¹ ≤ (↑(n : ℚ))⁻¹ := (inv_le_inv₀ hmn hnp).mpr (by exact_mod_cast hnm)
exact mul_le_mul_of_nonneg_left hle (by positivity)
calc
((n - a : ℕ) : ℚ) / (m : ℚ) = ((n - a : ℕ) : ℚ) * (↑(m : ℚ))⁻¹ := by ring
_ ≤ ((n - a : ℕ) : ℚ) * (↑(n : ℚ))⁻¹ := hnm'
_ = ∑ i ∈ Finset.Ico a n, (↑(n : ℚ))⁻¹ := hconst.symm
_ ≤ ∑ i ∈ Finset.Ico a n, (↑(i + 1 : ℕ) : ℚ)⁻¹ := hterm
_ = harmonic n - harmonic a := hIco.symm
The cost of GREEDY-SET-COVER on the uncovered set U: the number of sets
the greedy algorithm picks until U is exhausted. Each step picks a set of
F covering as many uncovered elements as any other (pickSet) and removes
the elements it covers. The covering hypothesis hcov guarantees the uncovered
set strictly shrinks, so the loop terminates (CLRS §35.3, GREEDY-SET-COVER).
noncomputable def greedyCost (F : Finset (Finset α)) : (U : Finset α) → (∀ x ∈ U, ∃ S ∈ F, x ∈ S) → ℚ
| U, hcov =>
if hU : U = ∅ then 0
else
let hF : F.Nonempty := cover_nonempty F hcov (Finset.nonempty_iff_ne_empty.mpr hU)
let S := pickSet F U hF
(1 : ℚ) + greedyCost F (U \ S) (cover_sub F hcov (Finset.sdiff_subset (s := U) (t := S)))
termination_by U => U.card
decreasing_by
classical
exact pickSet_sdiff_card_lt F hcov (Finset.nonempty_iff_ne_empty.mpr hU)
The charge accrued by the elements of A while the greedy algorithm runs
on the uncovered set U: each step of coverage charges 1 / |new| to every
element of A covered at that step, where new is the set of newly covered
elements. This is the internal quantity behind Theorem 35.3's charging
argument: greedyCost F U hcov equals chargeSum F U hcov U.
noncomputable def chargeSum (F : Finset (Finset α)) :
(U : Finset α) → (∀ x ∈ U, ∃ S ∈ F, x ∈ S) → (A : Finset α) → ℚ
| U, hcov, A =>
if hU : U = ∅ then 0
else
let hF : F.Nonempty := cover_nonempty F hcov (Finset.nonempty_iff_ne_empty.mpr hU)
let S := pickSet F U hF
((A ∩ S).card : ℚ) * ((S ∩ U).card : ℚ)⁻¹
+ chargeSum F (U \ S) (cover_sub F hcov (Finset.sdiff_subset (s := U) (t := S))) (A \ S)
termination_by U => U.card
decreasing_by
classical
exact pickSet_sdiff_card_lt F hcov (Finset.nonempty_iff_ne_empty.mpr hU)The greedy pick of a covered nonempty universe covers at least one uncovered element.
lemma pickSet_covers_nonempty (F : Finset (Finset α)) {U : Finset α}
(hcov : ∀ x ∈ U, ∃ S ∈ F, x ∈ S) (hU : U.Nonempty) :
(pickSet F U (cover_nonempty F hcov hU) ∩ U).Nonempty := by
classical
let x := hU.choose
have hxU : x ∈ U := hU.choose_spec
rcases hcov x hxU with ⟨S, hS, hxS⟩
have hScover : 1 ≤ (S ∩ U).card := by
have hpos : 0 < (S ∩ U).card := Finset.card_pos.mpr ⟨x, Finset.mem_inter.mpr ⟨hxS, hxU⟩⟩
omega
exact Finset.card_pos.mp (le_trans hScover (pickSet_coverage_le F U (cover_nonempty F hcov hU) hS))
The family of sets returned by GREEDY-SET-COVER on the uncovered set U:
the greedy picks accumulated until U is exhausted.
noncomputable def greedySetCover (F : Finset (Finset α)) : (U : Finset α) → (∀ x ∈ U, ∃ S ∈ F, x ∈ S) → Finset (Finset α)
| U, hcov =>
if hU : U = ∅ then ∅
else
let hF : F.Nonempty := cover_nonempty F hcov (Finset.nonempty_iff_ne_empty.mpr hU)
let S := pickSet F U hF
insert S (greedySetCover F (U \ S) (cover_sub F hcov (Finset.sdiff_subset (s := U) (t := S))))
termination_by U => U.card
decreasing_by
classical
exact pickSet_sdiff_card_lt F hcov (Finset.nonempty_iff_ne_empty.mpr hU)
The family returned by GREEDY-SET-COVER is drawn from the input family F.
lemma greedySetCover_subset (F : Finset (Finset α)) {U : Finset α}
(hcov : ∀ x ∈ U, ∃ S ∈ F, x ∈ S) :
greedySetCover F U hcov ⊆ F := by
classical
let R : Finset α → Finset α → Prop := fun a b => a.card < b.card
have hwf : WellFounded R := (measure (fun s : Finset α => s.card)).wf
let P : Finset α → Prop := fun U' =>
∀ hcov' : ∀ x ∈ U', ∃ S ∈ F, x ∈ S, greedySetCover F U' hcov' ⊆ F
have hmain : ∀ U' : Finset α, P U' := by
refine hwf.fix (C := P) ?_
intro U' ih hcov'
by_cases hU : U' = ∅
· subst U'
rw [greedySetCover.eq_1]
simp
· let hF : F.Nonempty := cover_nonempty F hcov' (Finset.nonempty_iff_ne_empty.mpr hU)
let S := pickSet F U' hF
have hlt : (U' \ S).card < U'.card :=
pickSet_sdiff_card_lt F hcov' (Finset.nonempty_iff_ne_empty.mpr hU)
have ih' : greedySetCover F (U' \ S) (cover_sub F hcov' (Finset.sdiff_subset (s := U') (t := S))) ⊆ F :=
ih (U' \ S) hlt (cover_sub F hcov' (Finset.sdiff_subset (s := U') (t := S)))
rw [greedySetCover.eq_1, dif_neg hU]
intro T hT
rw [Finset.mem_insert] at hT
rcases hT with hT_eq | hT_mem
· subst T
exact pickSet_mem F U' hF
· exact ih' hT_mem
exact hmain U hcov
Theorem 35.3 (correctness). The family returned by GREEDY-SET-COVER covers
its universe: every element of U lies in some chosen set.
lemma greedySetCover_covers (F : Finset (Finset α)) {U : Finset α}
(hcov : ∀ x ∈ U, ∃ S ∈ F, x ∈ S) :
Covers U (greedySetCover F U hcov) := by
classical
let R : Finset α → Finset α → Prop := fun a b => a.card < b.card
have hwf : WellFounded R := (measure (fun s : Finset α => s.card)).wf
let P : Finset α → Prop := fun U' =>
∀ hcov' : ∀ x ∈ U', ∃ S ∈ F, x ∈ S, Covers U' (greedySetCover F U' hcov')
have hmain : ∀ U' : Finset α, P U' := by
refine hwf.fix (C := P) ?_
intro U' ih hcov'
by_cases hU : U' = ∅
· subst U'
intro x hx
simp at hx
· let hF : F.Nonempty := cover_nonempty F hcov' (Finset.nonempty_iff_ne_empty.mpr hU)
let S := pickSet F U' hF
have hlt : (U' \ S).card < U'.card :=
pickSet_sdiff_card_lt F hcov' (Finset.nonempty_iff_ne_empty.mpr hU)
have hcov'' : ∀ x ∈ U' \ S, ∃ T ∈ F, x ∈ T :=
cover_sub F hcov' (Finset.sdiff_subset (s := U') (t := S))
have ih' : Covers (U' \ S) (greedySetCover F (U' \ S) hcov'') :=
ih (U' \ S) hlt hcov''
rw [greedySetCover.eq_1, dif_neg hU]
intro x hx
by_cases hxS : x ∈ S
· exact ⟨S, Finset.mem_insert.mpr (Or.inl rfl), hxS⟩
· rcases ih' x (Finset.mem_sdiff.mpr ⟨hx, hxS⟩) with ⟨T, hT, hxT⟩
exact ⟨T, Finset.mem_insert.mpr (Or.inr hT), hxT⟩
exact hmain U hcovThe greedy cost is exactly the charge accrued by the elements of the whole universe.
lemma greedyCost_eq_chargeSum (F : Finset (Finset α)) {U : Finset α}
(hcov : ∀ x ∈ U, ∃ S ∈ F, x ∈ S) :
greedyCost F U hcov = chargeSum F U hcov U := by
classical
let R : Finset α → Finset α → Prop := fun a b => a.card < b.card
have hwf : WellFounded R := (measure (fun s : Finset α => s.card)).wf
let P : Finset α → Prop := fun U' =>
∀ hcov' : ∀ x ∈ U', ∃ S ∈ F, x ∈ S, greedyCost F U' hcov' = chargeSum F U' hcov' U'
have hmain : ∀ U' : Finset α, P U' := by
refine hwf.fix (C := P) ?_
intro U' ih hcov'
by_cases hU : U' = ∅
· subst U'
rw [greedyCost.eq_1, chargeSum.eq_1]
simp
· let hF : F.Nonempty := cover_nonempty F hcov' (Finset.nonempty_iff_ne_empty.mpr hU)
let S := pickSet F U' hF
have hlt : (U' \ S).card < U'.card :=
pickSet_sdiff_card_lt F hcov' (Finset.nonempty_iff_ne_empty.mpr hU)
have hih : greedyCost F (U' \ S) (cover_sub F hcov' (Finset.sdiff_subset (s := U') (t := S)))
= chargeSum F (U' \ S) (cover_sub F hcov' (Finset.sdiff_subset (s := U') (t := S))) (U' \ S) :=
ih (U' \ S) hlt (cover_sub F hcov' (Finset.sdiff_subset (s := U') (t := S)))
have hone : ((U' ∩ S).card : ℚ) * ((S ∩ U').card : ℚ)⁻¹ = 1 := by
have hne0 : (S ∩ U').card ≠ 0 := by
have hpos : 1 ≤ (S ∩ U').card :=
Finset.card_pos.mpr (pickSet_covers_nonempty F hcov' (Finset.nonempty_iff_ne_empty.mpr hU))
omega
have hc : (U' ∩ S).card = (S ∩ U').card := by rw [Finset.inter_comm]
rw [hc]
exact mul_inv_cancel₀ (by exact_mod_cast hne0)
calc
greedyCost F U' hcov' = 1 + greedyCost F (U' \ S) (cover_sub F hcov' (Finset.sdiff_subset (s := U') (t := S))) := by
rw [greedyCost.eq_1, dif_neg hU]
_ = ((U' ∩ S).card : ℚ) * ((S ∩ U').card : ℚ)⁻¹
+ chargeSum F (U' \ S) (cover_sub F hcov' (Finset.sdiff_subset (s := U') (t := S))) (U' \ S) := by
rw [hone, hih]
_ = chargeSum F U' hcov' U' := by
conv_rhs => rw [chargeSum.eq_1]
rw [dif_neg hU]
exact hmain U hcov
Lemma (charge bound). A set A of elements still uncovered — necessarily a
subset of some set of F — is charged at most H(|A|) over the whole greedy
run. This is the charging step of Theorem 35.3: when the greedy pick first
covers an element of A, it covers at least |A| uncovered elements, so the
price per element is at most the corresponding harmonic term.
lemma chargeSum_le_harmonic (F : Finset (Finset α)) {U : Finset α}
(hcov : ∀ x ∈ U, ∃ S ∈ F, x ∈ S) {A : Finset α}
(hA : A ⊆ U) (hAS : ∃ S ∈ F, A ⊆ S) :
chargeSum F U hcov A ≤ harmonic A.card := by
classical
let R : Finset α → Finset α → Prop := fun a b => a.card < b.card
have hwf : WellFounded R := (measure (fun s : Finset α => s.card)).wf
let P : Finset α → Prop := fun U' =>
∀ hcov' : ∀ x ∈ U', ∃ S ∈ F, x ∈ S, ∀ A' : Finset α,
A' ⊆ U' → (∃ S ∈ F, A' ⊆ S) → chargeSum F U' hcov' A' ≤ harmonic A'.card
have hmain : ∀ U' : Finset α, P U' := by
refine hwf.fix (C := P) ?_
intro U' ih hcov' A' hA' hAS'
by_cases hU : U' = ∅
· subst U'
rw [chargeSum.eq_1]
simp
exact harmonic_nonneg A'.card
· let hF : F.Nonempty := cover_nonempty F hcov' (Finset.nonempty_iff_ne_empty.mpr hU)
let S := pickSet F U' hF
have hlt : (U' \ S).card < U'.card :=
pickSet_sdiff_card_lt F hcov' (Finset.nonempty_iff_ne_empty.mpr hU)
have hA'2 : A' \ S ⊆ U' \ S := by
intro x hx
exact Finset.mem_sdiff.mpr ⟨hA' (Finset.mem_sdiff.mp hx).1, (Finset.mem_sdiff.mp hx).2⟩
rcases hAS' with ⟨S0, hS0F, hA'S0⟩
have hAS'2 : ∃ S1 ∈ F, A' \ S ⊆ S1 := ⟨S0, hS0F, by
intro x hx
exact hA'S0 (Finset.mem_sdiff.mp hx).1⟩
have hterm2 : chargeSum F (U' \ S) (cover_sub F hcov' (Finset.sdiff_subset (s := U') (t := S))) (A' \ S)
≤ harmonic (A' \ S).card :=
ih (U' \ S) hlt (cover_sub F hcov' (Finset.sdiff_subset (s := U') (t := S))) (A' \ S) hA'2 hAS'2
have hcard : (A' ∩ S).card = A'.card - (A' \ S).card := by
have hsum : (A' ∩ S).card + (A' \ S).card = A'.card := Finset.card_inter_add_card_sdiff A' S
omega
have hterm1 : ((A' ∩ S).card : ℚ) * ((S ∩ U').card : ℚ)⁻¹
≤ harmonic A'.card - harmonic (A' \ S).card := by
by_cases hAe : A' = ∅
· subst A'
simp
· have hn : 0 < A'.card := Finset.card_pos.mpr (Finset.nonempty_iff_ne_empty.mpr hAe)
have hAS0 : A'.card ≤ (S0 ∩ U').card := by
apply Finset.card_le_card
intro x hx
exact Finset.mem_inter.mpr ⟨hA'S0 hx, hA' hx⟩
have hnm : A'.card ≤ (S ∩ U').card :=
le_trans hAS0 (pickSet_coverage_le F U' hF hS0F)
have hb := harm_bound (A' \ S).card A'.card (S ∩ U').card
(Finset.card_le_card (Finset.sdiff_subset (s := A') (t := S))) hn hnm
rw [hcard]
exact hb
calc
chargeSum F U' hcov' A' = ((A' ∩ S).card : ℚ) * ((S ∩ U').card : ℚ)⁻¹
+ chargeSum F (U' \ S) (cover_sub F hcov' (Finset.sdiff_subset (s := U') (t := S))) (A' \ S) := by
rw [chargeSum.eq_1, dif_neg hU]
_ ≤ (harmonic A'.card - harmonic (A' \ S).card) + harmonic (A' \ S).card := by
nlinarith [hterm1, hterm2]
_ = harmonic A'.card := by ring
exact hmain U hcov A hA hAS
If every element of T lies in some member of the family ℱ, then T is
no larger than the sum of the sizes of the members' intersections with T.
lemma card_le_sum_card_of_cover {T : Finset α} {ℱ : Finset (Finset α)}
(h : ∀ x ∈ T, ∃ S ∈ ℱ, x ∈ S) :
T.card ≤ ∑ S ∈ ℱ, (S ∩ T).card := by
classical
have hsub : T ⊆ Finset.biUnion ℱ (fun S : Finset α => S ∩ T) := by
intro x hx
rcases h x hx with ⟨S, hS, hxS⟩
exact Finset.mem_biUnion.mpr ⟨S, hS, Finset.mem_inter.mpr ⟨hxS, hx⟩⟩
have hcard : T.card ≤ (Finset.biUnion ℱ (fun S : Finset α => S ∩ T)).card :=
Finset.card_le_card hsub
have hcard2 : (Finset.biUnion ℱ (fun S : Finset α => S ∩ T)).card ≤ ∑ S ∈ ℱ, (S ∩ T).card := by
exact Finset.card_biUnion_le (s := ℱ) (t := fun S : Finset α => S ∩ T)
exact le_trans hcard hcard2
The total charge of the whole uncovered set is no more than the sum, over a
cover C of the universe, of the charges of the cover sets' portions of the
uncovered set.
lemma chargeSum_U_le_sum_cover (F : Finset (Finset α)) (X U : Finset α) (C : Finset (Finset α))
(hU : U ⊆ X) (hC : Covers X C) (hcov : ∀ x ∈ U, ∃ S ∈ F, x ∈ S) :
chargeSum F U hcov U ≤ ∑ S ∈ C, chargeSum F U hcov (S ∩ U) := by
classical
let R : Finset α → Finset α → Prop := fun a b => a.card < b.card
have hwf : WellFounded R := (measure (fun s : Finset α => s.card)).wf
let P : Finset α → Prop := fun U' =>
∀ hcov' : ∀ x ∈ U', ∃ S ∈ F, x ∈ S, U' ⊆ X →
chargeSum F U' hcov' U' ≤ ∑ S ∈ C, chargeSum F U' hcov' (S ∩ U')
have hmain : ∀ U' : Finset α, P U' := by
refine hwf.fix (C := P) ?_
intro U' ih hcov' hU'X
by_cases hU : U' = ∅
· subst U'
simp [chargeSum.eq_1]
· let hF : F.Nonempty := cover_nonempty F hcov' (Finset.nonempty_iff_ne_empty.mpr hU)
let Sp := pickSet F U' hF
let U'' := U' \ Sp
let T := U' ∩ Sp
have hcov'' : ∀ x ∈ U'', ∃ S ∈ F, x ∈ S :=
cover_sub F hcov' (Finset.sdiff_subset (s := U') (t := Sp))
have hlt : U''.card < U'.card := by
simpa [U''] using pickSet_sdiff_card_lt F hcov' (Finset.nonempty_iff_ne_empty.mpr hU)
have hstep : chargeSum F U' hcov' U' = (T.card : ℚ) * ((Sp ∩ U').card : ℚ)⁻¹
+ chargeSum F U'' hcov'' U'' := by
rw [chargeSum.eq_1, dif_neg hU]
have h1 : (T.card : ℚ) * ((Sp ∩ U').card : ℚ)⁻¹
≤ ∑ S ∈ C, ((S ∩ T).card : ℚ) * ((Sp ∩ U').card : ℚ)⁻¹ := by
have hcoverT : ∀ x ∈ T, ∃ S ∈ C, x ∈ S := by
intro x hx
rcases hC x (hU'X (Finset.mem_inter.mp hx).1) with ⟨S, hS, hxS⟩
exact ⟨S, hS, hxS⟩
have hcardT : T.card ≤ ∑ S ∈ C, (S ∩ T).card := card_le_sum_card_of_cover hcoverT
have hcardQ : (T.card : ℚ) ≤ ∑ S ∈ C, ((S ∩ T).card : ℚ) := by
exact_mod_cast hcardT
rw [← Finset.sum_mul]
exact mul_le_mul_of_nonneg_right hcardQ (by positivity)
have h2 : chargeSum F U'' hcov'' U'' ≤ ∑ S ∈ C, chargeSum F U'' hcov'' (S ∩ U'') := by
exact ih U'' hlt hcov'' (by
intro x hx
exact hU'X (Finset.mem_sdiff.mp hx).1)
have hrhs : ∑ S ∈ C, chargeSum F U' hcov' (S ∩ U')
= ∑ S ∈ C, (((S ∩ T).card : ℚ) * ((Sp ∩ U').card : ℚ)⁻¹
+ chargeSum F U'' hcov'' (S ∩ U'')) := by
apply Finset.sum_congr rfl
intro S hS
have hSinter : (S ∩ U') ∩ Sp = S ∩ T := by
simp [T, Finset.inter_assoc]
have hSdiff : (S ∩ U') \ Sp = S ∩ U'' := by
dsimp [U'']
ext x; simp [Finset.mem_sdiff, Finset.mem_inter]; tauto
rw [chargeSum.eq_1, dif_neg hU]
simp [Sp, U'', hSinter, hSdiff]
calc
chargeSum F U' hcov' U' = (T.card : ℚ) * ((Sp ∩ U').card : ℚ)⁻¹ + chargeSum F U'' hcov'' U'' := hstep
_ ≤ ∑ S ∈ C, (((S ∩ T).card : ℚ) * ((Sp ∩ U').card : ℚ)⁻¹
+ chargeSum F U'' hcov'' (S ∩ U'')) := by
rw [Finset.sum_add_distrib]
exact add_le_add h1 h2
_ = ∑ S ∈ C, chargeSum F U' hcov' (S ∩ U') := hrhs.symm
exact hmain U hcov hU
Theorem 35.3. GREEDY-SET-COVER returns a set cover whose cost is at most
H(d) · |C| for every cover C of X — in particular, for an optimal one —
where d bounds the sizes of the sets in F and H is the harmonic number.
Thus GREEDY-SET-COVER is an H(d)-approximation algorithm (CLRS §35.3).
Indeed, the cost is the total charge (greedyCost_eq_chargeSum), the total
charge is no more than the sum over a cover of its per-set charges
(chargeSum_U_le_sum_cover), each per-set charge is at most H(|S|)
(chargeSum_le_harmonic), and H(|S|) ≤ H(d) by monotonicity.
theorem greedySetCover_approx (X : Finset α) (F : Finset (Finset α))
(hcov : ∀ x ∈ X, ∃ S ∈ F, x ∈ S)
(d : ℕ) (hd : ∀ S ∈ F, S.card ≤ d)
(C : Finset (Finset α)) (hCsub : C ⊆ F) (hCcov : Covers X C) :
greedyCost F X hcov ≤ harmonic d * (C.card : ℚ) := by
classical
have h1 := greedyCost_eq_chargeSum F hcov
have h2 := chargeSum_U_le_sum_cover F X X C (le_refl X) hCcov hcov
have h3 : ∀ S ∈ C, chargeSum F X hcov (S ∩ X) ≤ harmonic d := by
intro S hS
have hSsubF : S ∈ F := hCsub hS
have hleS : chargeSum F X hcov (S ∩ X) ≤ harmonic (S ∩ X).card :=
chargeSum_le_harmonic F hcov
(by intro x hx; exact (Finset.mem_inter.mp hx).2)
⟨S, hSsubF, by intro x hx; exact (Finset.mem_inter.mp hx).1⟩
have hcard : (S ∩ X).card ≤ S.card := Finset.card_le_card Finset.inter_subset_left
have hcard' : (S ∩ X).card ≤ d := le_trans hcard (hd S hSsubF)
exact le_trans hleS (harmonic_mono hcard')
have h4 : (∑ S ∈ C, chargeSum F X hcov (S ∩ X)) ≤ ∑ S ∈ C, harmonic d := by
exact Finset.sum_le_sum h3
have h5 : (∑ S ∈ C, harmonic d) = (C.card : ℚ) * harmonic d := by
rw [Finset.sum_const]
norm_num
calc
greedyCost F X hcov = chargeSum F X hcov X := h1
_ ≤ ∑ S ∈ C, chargeSum F X hcov (S ∩ X) := h2
_ ≤ ∑ S ∈ C, harmonic d := h4
_ = harmonic d * (C.card : ℚ) := by
rw [h5]
ring
If the family C covers the nonempty set U, then some set of C covers
at least |U| / |C| elements of U. This is the averaging step of Theorem
35.4: a size-k cover distributes |U| elements among its k sets.
lemma exists_cover_set_ge_fraction {U : Finset α} {C : Finset (Finset α)}
(hC : Covers U C) (hU : U.Nonempty) :
∃ S ∈ C, (U.card : ℚ) / (C.card : ℚ) ≤ ((S ∩ U).card : ℚ) := by
classical
have hCne : C.Nonempty := cover_nonempty C hC hU
have hsum : (U.card : ℚ) ≤ ∑ S ∈ C, ((S ∩ U).card : ℚ) := by
exact_mod_cast card_le_sum_card_of_cover hC
by_contra hnone
have hall : ∀ S ∈ C, ((S ∩ U).card : ℚ) < (U.card : ℚ) / (C.card : ℚ) := by
intro S hS
exact lt_of_not_ge (fun hge => hnone ⟨S, hS, hge⟩)
have hle : ∀ S ∈ C, ((S ∩ U).card : ℚ) ≤ (U.card : ℚ) / (C.card : ℚ) := by
intro S hS
exact le_of_lt (hall S hS)
have hstrict : (∑ S ∈ C, ((S ∩ U).card : ℚ)) < ∑ S ∈ C, ((U.card : ℚ) / (C.card : ℚ)) := by
refine Finset.sum_lt_sum hle ?_
rcases hCne with ⟨S0, hS0⟩
exact ⟨S0, hS0, hall S0 hS0⟩
have hsumlt : (∑ S ∈ C, ((S ∩ U).card : ℚ)) < (C.card : ℚ) * ((U.card : ℚ) / (C.card : ℚ)) := by
rwa [Finset.sum_const, nsmul_eq_mul] at hstrict
have hcancel : (C.card : ℚ) * ((U.card : ℚ) / (C.card : ℚ)) = (U.card : ℚ) := by
have hc : (C.card : ℚ) ≠ 0 := by exact_mod_cast (Finset.card_ne_zero.mpr hCne)
field_simp [hc]
linarith
The greedy pick covers at least |U| / |C| elements of the uncovered set
U, because some set of the cover C — which is a subfamily of F — covers
that many, and the greedy pick covers at least as many as any set of F.
lemma pickSet_cover_fraction (F : Finset (Finset α)) {U : Finset α}
(hcov : ∀ x ∈ U, ∃ S ∈ F, x ∈ S) {C : Finset (Finset α)}
(hCsub : C ⊆ F) (hCcov : Covers U C) (hU : U.Nonempty) :
(U.card : ℚ) / (C.card : ℚ) ≤ ((pickSet F U (cover_nonempty F hcov hU) ∩ U).card : ℚ) := by
classical
rcases exists_cover_set_ge_fraction hCcov hU with ⟨S, hS, hSfrac⟩
have hle : (S ∩ U).card ≤ (pickSet F U (cover_nonempty F hcov hU) ∩ U).card :=
pickSet_coverage_le F U (cover_nonempty F hcov hU) (hCsub hS)
exact le_trans hSfrac (by exact_mod_cast hle)
One greedy step shrinks the uncovered set by the factor (1 - 1/|C|): since
the greedy pick covers at least |U| / |C| elements, the remainder U \ S has
at most |U| · (1 - 1/|C|) elements. This is the multiplicative decrease of
Theorem 35.4's proof.
lemma pickSet_sdiff_shrink (F : Finset (Finset α)) {U : Finset α}
(hcov : ∀ x ∈ U, ∃ S ∈ F, x ∈ S) {C : Finset (Finset α)}
(hCsub : C ⊆ F) (hCcov : Covers U C) (hU : U.Nonempty) :
((U \ pickSet F U (cover_nonempty F hcov hU)).card : ℚ) ≤
(U.card : ℚ) * (1 - (C.card : ℚ)⁻¹) := by
classical
let S := pickSet F U (cover_nonempty F hcov hU)
have hf := pickSet_cover_fraction F hcov hCsub hCcov hU
have hsplit : ((U \ S).card : ℚ) = (U.card : ℚ) - ((U ∩ S).card : ℚ) := by
have hc : (U ∩ S).card + (U \ S).card = U.card := Finset.card_inter_add_card_sdiff U S
linarith [show ((U ∩ S).card : ℚ) + ((U \ S).card : ℚ) = (U.card : ℚ) from by exact_mod_cast hc]
calc
((U \ S).card : ℚ) = (U.card : ℚ) - ((U ∩ S).card : ℚ) := hsplit
_ ≤ (U.card : ℚ) - (U.card : ℚ) / (C.card : ℚ) := by
have hle : (U.card : ℚ) / (C.card : ℚ) ≤ ((U ∩ S).card : ℚ) := by
simpa [S, Finset.inter_comm] using hf
linarith
_ = (U.card : ℚ) * (1 - (C.card : ℚ)⁻¹) := by ring
Fuel bound. If after N greedy steps the uncovered size is bounded by the
N-th power of the shrink factor (1 - 1/|C|), then the greedy loop has
terminated: greedyCost ≤ N. More precisely, if |U| · (1 - 1/|C|)^N < 1
then the cost is at most N. This is the iteration step of Theorem 35.4.
lemma greedyCost_le_fuel (F : Finset (Finset α)) {U : Finset α}
(hcov : ∀ x ∈ U, ∃ S ∈ F, x ∈ S) {C : Finset (Finset α)}
(hCsub : C ⊆ F) (hCcov : Covers U C) (N : ℕ)
(hN : (U.card : ℚ) * ((1 - (C.card : ℚ)⁻¹) ^ N) < 1) :
greedyCost F U hcov ≤ N := by
classical
let R : Finset α → Finset α → Prop := fun a b => a.card < b.card
have hwf : WellFounded R := (measure (fun s : Finset α => s.card)).wf
let P : Finset α → Prop := fun U' =>
∀ hcov' : ∀ x ∈ U', ∃ S ∈ F, x ∈ S, ∀ hCsub' : C ⊆ F,
∀ hCcov' : Covers U' C, ∀ N' : ℕ,
(U'.card : ℚ) * ((1 - (C.card : ℚ)⁻¹) ^ N') < 1 → greedyCost F U' hcov' ≤ N'
have hmain : ∀ U' : Finset α, P U' := by
refine hwf.fix (C := P) ?_
intro U' ih hcov' hCsub' hCcov' N' hN'
by_cases hU : U' = ∅
· subst U'
rw [greedyCost.eq_1]
simp
· let hF : F.Nonempty := cover_nonempty F hcov' (Finset.nonempty_iff_ne_empty.mpr hU)
let S := pickSet F U' hF
have hlt : (U' \ S).card < U'.card :=
pickSet_sdiff_card_lt F hcov' (Finset.nonempty_iff_ne_empty.mpr hU)
have hcov'' : ∀ x ∈ U' \ S, ∃ T ∈ F, x ∈ T :=
cover_sub F hcov' (Finset.sdiff_subset (s := U') (t := S))
have hCcov'' : Covers (U' \ S) C := by
intro x hx
exact hCcov' x (Finset.mem_sdiff.mp hx).1
by_cases hN0 : N' = 0
· subst N'
have hcard1 : (1 : ℕ) ≤ U'.card := by
have hpos : 0 < U'.card := Finset.card_pos.mpr (Finset.nonempty_iff_ne_empty.mpr hU)
omega
have hone : (1 : ℚ) ≤ (U'.card : ℚ) := by exact_mod_cast hcard1
have hlt1 : (U'.card : ℚ) < 1 := by simpa using hN'
linarith
· obtain ⟨N'', rfl⟩ := Nat.exists_eq_succ_of_ne_zero hN0
let c : ℚ := 1 - (C.card : ℚ)⁻¹
have hinv_le : (C.card : ℚ)⁻¹ ≤ 1 := by
by_cases hk0 : C.card = 0
· simp [hk0]
· have hk1 : 1 ≤ C.card := Nat.succ_le_of_lt (Nat.pos_of_ne_zero hk0)
have hkq : (1 : ℚ) ≤ (C.card : ℚ) := by exact_mod_cast hk1
exact inv_le_one_of_one_le₀ hkq
have hcnonneg : 0 ≤ c := by
dsimp [c]
linarith
have hshrink := pickSet_sdiff_shrink F hcov' hCsub' hCcov' (Finset.nonempty_iff_ne_empty.mpr hU)
have hfuel' : ((U' \ S).card : ℚ) * (c ^ N'') < 1 := by
have hcpow : 0 ≤ c ^ N'' := pow_nonneg hcnonneg N''
have hmul : ((U' \ S).card : ℚ) * (c ^ N'') ≤ (U'.card : ℚ) * (c ^ (N'' + 1)) := by
calc
((U' \ S).card : ℚ) * (c ^ N'') ≤ (U'.card : ℚ) * c * (c ^ N'') := by
exact mul_le_mul_of_nonneg_right hshrink hcpow
_ = (U'.card : ℚ) * (c * (c ^ N'')) := by ring
_ = (U'.card : ℚ) * (c ^ (N'' + 1)) := by rw [pow_succ]; ring
exact lt_of_le_of_lt hmul (by simpa [c] using hN')
have hfuel'' : ((U' \ S).card : ℚ) * ((1 - (C.card : ℚ)⁻¹) ^ N'') < 1 := by
simpa [c] using hfuel'
have ih' : greedyCost F (U' \ S) hcov'' ≤ N'' :=
ih (U' \ S) hlt hcov'' hCsub' hCcov'' N'' hfuel''
rw [greedyCost.eq_1, dif_neg hU]
have hsum : (1 : ℚ) + greedyCost F (U' \ S) hcov'' ≤ (1 : ℚ) + (N'' : ℚ) := by
nlinarith [ih']
have hcast : ((N'' + 1 : ℕ) : ℚ) = (1 : ℚ) + (N'' : ℚ) := by
norm_num [Nat.cast_add, add_comm]
nlinarith
exact hmain U hcov hCsub hCcov N hN
Theorem 35.4. GREEDY-SET-COVER is an O(lg |X|)-approximation algorithm:
for every cover C of X, the greedy cost is at most |C| · (⌈ln |X|⌉ + 1)
(CLRS §35.3, Theorem 35.4).
The proof iterates the multiplicative shrink |U_{i+1}| ≤ |U_i| · (1 - 1/|C|):
after |C| · ⌈ln |X|⌉ steps the uncovered set has size below 1, so the loop
has terminated. The comparison 1 - 1/k ≤ e^{-1/k} turns the iterated shrink
into the exponential bound |X| · (1 - 1/k)^{k·L} ≤ |X| · e^{-L} < 1, where
L = ⌈ln |X|⌉ + 1.
theorem greedySetCover_ln_approx (X : Finset α) (F : Finset (Finset α))
(hcov : ∀ x ∈ X, ∃ S ∈ F, x ∈ S)
(C : Finset (Finset α)) (hCsub : C ⊆ F) (hCcov : Covers X C) :
greedyCost F X hcov ≤ (C.card : ℚ) * (((⌈Real.log (X.card : ℝ)⌉ : ℤ).toNat + 1 : ℕ) : ℚ) := by
classical
let L : ℕ := (⌈Real.log (X.card : ℝ)⌉ : ℤ).toNat + 1
let k : ℕ := C.card
let cQ : ℚ := 1 - (k : ℚ)⁻¹
let cR : ℝ := 1 - (k : ℝ)⁻¹
have hfuel : (X.card : ℚ) * (cQ ^ (k * L)) < 1 := by
by_cases hX0 : X = ∅
· subst X
simp [cQ]
· by_cases hk0 : k = 0
· have hCempty : C = ∅ := Finset.card_eq_zero.mp (by simpa [k] using hk0)
have hXempty : X = ∅ := by
by_contra hne
rcases Finset.nonempty_iff_ne_empty.mpr hne with ⟨x, hx⟩
rcases hCcov x hx with ⟨S, hS, _⟩
simpa [hCempty] using hS
contradiction
· have hk1 : 1 ≤ k := Nat.succ_le_of_lt (Nat.pos_of_ne_zero hk0)
have hXposn : 0 < X.card := Finset.card_pos.mpr (Finset.nonempty_iff_ne_empty.mpr hX0)
have hX1n : 1 ≤ X.card := Nat.succ_le_of_lt hXposn
have hkℝ : (k : ℝ) ≠ 0 := by exact_mod_cast hk0
have hcRnonneg : 0 ≤ cR := by
dsimp [cR]
have hinv : (k : ℝ)⁻¹ ≤ 1 := by
have hkq : (1 : ℝ) ≤ (k : ℝ) := by exact_mod_cast hk1
exact inv_le_one_of_one_le₀ hkq
linarith
have hpow1 : cR ^ k ≤ Real.exp (-1) := by
have hbase : cR ≤ Real.exp (-(k : ℝ)⁻¹) := by
dsimp [cR]
have h := Real.add_one_le_exp (-(k : ℝ)⁻¹)
linarith
calc
cR ^ k ≤ (Real.exp (-(k : ℝ)⁻¹)) ^ k := pow_le_pow_left₀ hcRnonneg hbase k
_ = Real.exp (k * (-(k : ℝ)⁻¹)) := by rw [Real.exp_nat_mul]
_ = Real.exp (-1) := by
have hmul : k * (-(k : ℝ)⁻¹) = -1 := by
rw [mul_neg, mul_inv_cancel₀ hkℝ]
rw [hmul]
have hpow2 : (cR ^ k) ^ L ≤ Real.exp (-(L : ℝ)) := by
have hb : 0 ≤ cR ^ k := pow_nonneg hcRnonneg k
calc
(cR ^ k) ^ L ≤ (Real.exp (-1)) ^ L := pow_le_pow_left₀ hb hpow1 L
_ = Real.exp (L * (-1)) := by rw [Real.exp_nat_mul]
_ = Real.exp (-(L : ℝ)) := by ring_nf
have hleR : (X.card : ℝ) * (cR ^ (k * L)) ≤ (X.card : ℝ) * Real.exp (-(L : ℝ)) := by
have h1 : cR ^ (k * L) ≤ Real.exp (-(L : ℝ)) := by
rw [pow_mul]
exact hpow2
exact mul_le_mul_of_nonneg_left h1 (by exact_mod_cast (Nat.zero_le X.card))
have hltR : (X.card : ℝ) * Real.exp (-(L : ℝ)) < 1 := by
have hXpos : 0 < (X.card : ℝ) := by exact_mod_cast hXposn
have hlog : Real.exp (Real.log (X.card : ℝ)) = (X.card : ℝ) := Real.exp_log hXpos
have hlogn : 0 ≤ Real.log (X.card : ℝ) := Real.log_nonneg (by exact_mod_cast hX1n)
have hceil0 : 0 ≤ (⌈Real.log (X.card : ℝ)⌉ : ℤ) := Int.ceil_nonneg hlogn
have hL : (L : ℝ) = ((⌈Real.log (X.card : ℝ)⌉ : ℤ) : ℝ) + 1 := by
dsimp [L]
have htoNat : ((⌈Real.log (X.card : ℝ)⌉ : ℤ).toNat : ℤ) = ⌈Real.log (X.card : ℝ)⌉ :=
Int.toNat_of_nonneg hceil0
have htoNatℝ : ((⌈Real.log (X.card : ℝ)⌉ : ℤ).toNat : ℝ) = ((⌈Real.log (X.card : ℝ)⌉ : ℤ) : ℝ) := by
exact_mod_cast htoNat
norm_num
rw [htoNatℝ]
have hltln : Real.log (X.card : ℝ) < (L : ℝ) := by
have h1 : Real.log (X.card : ℝ) < ((⌈Real.log (X.card : ℝ)⌉ : ℤ) : ℝ) + 1 := by
have hle : Real.log (X.card : ℝ) ≤ ((⌈Real.log (X.card : ℝ)⌉ : ℤ) : ℝ) := Int.le_ceil _
have hlt : ((⌈Real.log (X.card : ℝ)⌉ : ℤ) : ℝ) < Real.log (X.card : ℝ) + 1 := Int.ceil_lt_add_one _
nlinarith
rwa [hL]
have hsub : Real.log (X.card : ℝ) - (L : ℝ) < 0 := by linarith
calc
(X.card : ℝ) * Real.exp (-(L : ℝ)) = Real.exp (Real.log (X.card : ℝ)) * Real.exp (-(L : ℝ)) := by rw [hlog]
_ = Real.exp (Real.log (X.card : ℝ) + (-(L : ℝ))) := by rw [← Real.exp_add]
_ = Real.exp (Real.log (X.card : ℝ) - (L : ℝ)) := rfl
_ < Real.exp 0 := Real.exp_lt_exp.mpr hsub
_ = 1 := by norm_num
have hltQ : (X.card : ℚ) * (cQ ^ (k * L)) < 1 := by
have hltR' : (X.card : ℝ) * (cR ^ (k * L)) < 1 := lt_of_le_of_lt hleR hltR
have hcast : (cQ : ℝ) = cR := by
dsimp [cQ, cR]
norm_num
have hltR'' : (X.card : ℝ) * ((cQ : ℝ) ^ (k * L)) < 1 := by
simpa [hcast] using hltR'
exact_mod_cast hltR''
simpa [cQ, k] using hltQ
have hcost := greedyCost_le_fuel F hcov hCsub hCcov (k * L) (by simpa [cQ, k] using hfuel)
have hN : ((k * L : ℕ) : ℚ) = (k : ℚ) * (L : ℚ) := by norm_num [Nat.cast_mul]
simpa [hN, k, L] using hcostend SetCoverend CLRSDefinitions and proofs
CLRSLean.FourthEdition.Chapter_35.Section_35_3_The_Set_Covering_Problem.ReturnedFamily
Approximation bounds for the returned set family
The returned family and the pick count follow the same greedy choices. Every returned set intersects the initially uncovered universe, so an earlier pick cannot occur again after its elements have been removed. Thus the family cardinality equals the pick count, including the empty universe.
namespace CLRS.SetCoveropen Finsetvariable {α : Type} [DecidableEq α]
theorem greedySetCover_mem_inter_nonempty (F : Finset (Finset α)) {U : Finset α}
(hcov : ∀ x ∈ U, ∃ S ∈ F, x ∈ S) {S : Finset α}
(hS : S ∈ greedySetCover F U hcov) : (S ∩ U).Nonempty := by
classical
induction U using (measure (fun U : Finset α => U.card)).wf.induction with
| h U ih =>
by_cases hU : U = ∅
· subst U
rw [greedySetCover.eq_1] at hS
simp at hS
· let hF := cover_nonempty F hcov (Finset.nonempty_iff_ne_empty.mpr hU)
let T := pickSet F U hF
rw [greedySetCover.eq_1,dif_neg hU] at hS
rcases mem_insert.mp hS with heq | hmem
· subst S
exact pickSet_covers_nonempty F hcov (Finset.nonempty_iff_ne_empty.mpr hU)
· obtain ⟨x,hx⟩ := ih (U \ T)
(pickSet_sdiff_card_lt F hcov (Finset.nonempty_iff_ne_empty.mpr hU))
(cover_sub F hcov sdiff_subset) hmem
exact ⟨x,mem_inter.mpr ⟨(mem_inter.mp hx).1,(mem_sdiff.mp (mem_inter.mp hx).2).1⟩⟩No greedy pick is repeated: the actual returned cardinality equals the pick count.
theorem greedySetCover_card_eq_cost (F : Finset (Finset α)) {U : Finset α}
(hcov : ∀ x ∈ U, ∃ S ∈ F, x ∈ S) :
((greedySetCover F U hcov).card : ℚ) = greedyCost F U hcov := by
classical
induction U using (measure (fun U : Finset α => U.card)).wf.induction with
| h U ih =>
by_cases hU : U = ∅
· subst U
rw [greedySetCover.eq_1,greedyCost.eq_1]
simp
· let hF := cover_nonempty F hcov (Finset.nonempty_iff_ne_empty.mpr hU)
let T := pickSet F U hF
let hsub := cover_sub F hcov (sdiff_subset (s:=U) (t:=T))
have hnot : T ∉ greedySetCover F (U \ T) hsub := by
intro hmem
obtain ⟨x,hx⟩ := greedySetCover_mem_inter_nonempty F hsub hmem
exact (mem_sdiff.mp (mem_inter.mp hx).2).2 (mem_inter.mp hx).1
have hi := ih (U \ T)
(pickSet_sdiff_card_lt F hcov (Finset.nonempty_iff_ne_empty.mpr hU)) hsub
rw [greedySetCover.eq_1,greedyCost.eq_1,dif_neg hU,dif_neg hU]
rw [card_insert_of_notMem hnot,Nat.cast_add,Nat.cast_one,hi]
ringThe harmonic approximation bound applies directly to the returned family.
theorem greedySetCover_card_approx (X : Finset α) (F : Finset (Finset α))
(hcov : ∀ x ∈ X, ∃ S ∈ F, x ∈ S)
(d : Nat) (hd : ∀ S ∈ F, S.card ≤ d)
(C : Finset (Finset α)) (hCsub : C ⊆ F) (hCcov : Covers X C) :
((greedySetCover F X hcov).card : ℚ) ≤ harmonic d * (C.card : ℚ) := by
rw [greedySetCover_card_eq_cost]
exact greedySetCover_approx X F hcov d hd C hCsub hCcovThe logarithmic approximation bound also applies to the returned family.
theorem greedySetCover_card_ln_approx (X : Finset α) (F : Finset (Finset α))
(hcov : ∀ x ∈ X, ∃ S ∈ F, x ∈ S)
(C : Finset (Finset α)) (hCsub : C ⊆ F) (hCcov : Covers X C) :
((greedySetCover F X hcov).card : ℚ) ≤
(C.card : ℚ) * (((⌈Real.log (X.card : ℝ)⌉ : ℤ).toNat + 1 : Nat) : ℚ) := by
rw [greedySetCover_card_eq_cost]
exact greedySetCover_ln_approx X F hcov C hCsub hCcovend CLRS.SetCoverImports
import CLRSLean.FourthEdition.Chapter_35.Section_35_1_The_Vertex_Cover_Problem
import CLRSLean.Probability.FiniteExpectation
import Mathlib35.4. Randomization and Linear Programming
The vertex-cover LP execution constructs the program, invokes SIMPLEX, and rounds its optimum.
This section formalizes the two approximation techniques of CLRS §35.4:
randomization and linear programming. It covers (1) a randomized algorithm for
MAX-3-CNF satisfiability that achieves a randomized 8/7-approximation
(Theorem 35.5), and (2) an LP-rounding algorithm APPROX-MIN-WEIGHT-VC that
achieves a factor-two approximation for the minimum-weight vertex-cover problem
(Theorem 35.6).
Main results:
-
Definition
Literal,ClauseSatisfied,Is3CNFClause: a MAX-3-CNF clause is a set of literals (variable/sign pairs), satisfied by an assignment when one of its literals holds. -
Lemma
unsatisfied_prob: a uniformly random assignment leaves a valid 3-CNF clause unsatisfied with probability1/8— its three literals are over distinct variables, so exactly2^(n-3)of the2^nassignments take the negated value at each of them (card_assignments_fixing_three). -
Theorem
max3cnf_clause_satisfied_prob(Theorem 35.5): the clause is satisfied with probability7/8. -
Theorem
max3cnf_expect_satisfied(Theorem 35.5): the expected number of satisfied clauses over a familyFis exactly7/8 · |F|, by linearity of expectation. -
Theorem
max3cnf_approx(Theorem 35.5): MAX-3-CNF has a randomized8/7-approximation — every assignment is matched in expectation to at least7/8of the clauses it satisfies. -
Definition
IsFractionalCover: the feasible region of the vertex-cover LP relaxation — a vectorx : V → ℚwith0 ≤ x v ≤ 1andx(u) + x(v) ≥ 1for every edge. -
Definition
roundCover: APPROX-MIN-WEIGHT-VC's rounding — the vertices with fractional value at least1/2. -
Theorem
roundCover_isVertexCover(Theorem 35.6, correctness): the rounded vertices form a vertex cover. -
Theorem
approxMinWeightVC_two_approx(Theorem 35.6): the rounded cover's weight is at most twice the LP objective, hence at most twice the optimal cover's weight — a factor-two approximation.
The formula is an unweighted finite set of clauses: duplicates collapse and
weighted or repeated-clause objectives are outside this model. Each admitted
clause has three distinct variables. The rounding theorem below accepts a
fractional solution and its objective-bound premise. The companion
VertexCoverLP constructs a graph LP, calls initialized Chapter 29 SIMPLEX,
and derives that bound for its returned optimum before rounding.
Notation conventions used in this section:
-
n: the number of Boolean variables -
σ: an assignmentFin n → Bool(the sample space is uniform) -
(i, b): the literal "variableiis set tob" -
c: a clause (a set of literals) -
G: an undirected graph (edge-basedGraph V E) -
w: a positive vertex-weight function -
x: a fractional vertex cover (the LP relaxation's solution) -
C: a vertex cover
noncomputable sectionopen Finsetopen scoped BigOperatorsnamespace CLRSnamespace RandomizedLPopen CLRS.ProbabilityRandomization: MAX-3-CNF satisfiability (Theorem 35.5)
A literal is a pair (i, b): the assertion that variable i is set to b
(true for a positive literal, false for a negative one). A clause is a
set of literals, satisfied by an assignment when at least one of its literals
holds. The randomized algorithm sets every variable independently to true
with probability 1/2; a clause with three literals over three distinct
variables is then satisfied with probability 7/8 (Theorem 35.5).
variable {n : ℕ}
A literal: the assertion that variable i (of n) is set to b.
abbrev Literal (n : ℕ) := Fin n × Bool
An assignment: a setting of every variable to true or false.
abbrev Assignment (n : ℕ) := Fin n → Bool
A literal (i, b) holds under σ when σ i = b.
def litHolds (σ : Assignment n) (l : Literal n) : Prop :=
σ l.1 = l.2
A clause is satisfied by σ when at least one of its literals holds.
def ClauseSatisfied (c : Finset (Literal n)) (σ : Assignment n) : Prop :=
∃ l ∈ c, litHolds σ l
A clause is unsatisfied by σ when none of its literals holds.
def ClauseUnsatisfied (c : Finset (Literal n)) (σ : Assignment n) : Prop :=
∀ l ∈ c, ¬ litHolds σ lSatisfaction of a clause over a finite set of literals is decidable.
instance decClauseSatisfied (c : Finset (Literal n)) (σ : Assignment n) :
Decidable (ClauseSatisfied c σ) := by
unfold ClauseSatisfied litHolds
infer_instanceUnsatisfaction of a clause over a finite set of literals is decidable.
instance decClauseUnsatisfied (c : Finset (Literal n)) (σ : Assignment n) :
Decidable (ClauseUnsatisfied c σ) := by
unfold ClauseUnsatisfied litHolds
infer_instanceA valid MAX-3-CNF clause: exactly three literals, over three distinct variables (so no clause contains a variable and its negation).
def Is3CNFClause (c : Finset (Literal n)) : Prop :=
c.card = 3 ∧ ∀ ⦃l₁ l₂ : Literal n⦄, l₁ ∈ c → l₂ ∈ c → l₁ ≠ l₂ → l₁.1 ≠ l₂.1A clause is satisfied iff it is not unsatisfied.
lemma clauseSatisfied_iff_not_unsatisfied (c : Finset (Literal n)) (σ : Assignment n) :
ClauseSatisfied c σ ↔ ¬ ClauseUnsatisfied c σ := by
unfold ClauseSatisfied ClauseUnsatisfied litHolds
constructor
· intro h hnone
rcases h with ⟨l, hl, hlh⟩
exact hnone l hl hlh
· intro h
by_contra hnone
apply h
intro l hl
exact fun hlt => hnone ⟨l, hl, hlt⟩
In Bool, x ≠ b holds exactly when x is the negation of b.
lemma bool_ne_iff_not (x b : Bool) : x ≠ b ↔ x = Bool.not b := by
cases x <;> cases b <;> simp
The number of assignments that fix the value of three distinct variables is
2^(n-3): the remaining n-3 variables are free. This is the counting step of
Theorem 35.5 — a uniformly random assignment hits a given triple of values with
probability 2^(n-3) / 2^n = 1/8.
lemma card_assignments_fixing_three {i₁ i₂ i₃ : Fin n}
(hi12 : i₁ ≠ i₂) (hi13 : i₁ ≠ i₃) (hi23 : i₂ ≠ i₃) {v₁ v₂ v₃ : Bool} :
Fintype.card {σ : Assignment n // σ i₁ = v₁ ∧ σ i₂ = v₂ ∧ σ i₃ = v₃} = 2 ^ (n - 3) := by
classical
let C : Finset (Fin n) := {i₁, i₂, i₃}
let Free : Type := {k : Fin n // k ∉ C}
have hCcard : C.card = 3 := by
dsimp [C]
simp [hi12, hi13, hi23]
have hfree : Fintype.card Free = n - 3 := by
dsimp [Free, C]
have hsub := Fintype.card_subtype_compl (fun k : Fin n => k ∈ C)
rw [hsub]
simp [hCcard, Fintype.card_fin]
let e : {σ : Assignment n // σ i₁ = v₁ ∧ σ i₂ = v₂ ∧ σ i₃ = v₃} ≃ (Free → Bool) := {
toFun := fun σ k => σ.1 k.1
invFun := fun τ =>
⟨fun k => if h₁ : k = i₁ then v₁ else if h₂ : k = i₂ then v₂ else if h₃ : k = i₃ then v₃
else τ ⟨k, by
intro hkC
simp [C] at hkC
rcases hkC with h | h | h
· exact h₁ h
· exact h₂ h
· exact h₃ h⟩,
by
dsimp
constructor
· simp
· constructor
· simp [hi12.symm]
· simp [hi13.symm, hi23.symm]⟩
left_inv := by
intro σ
apply Subtype.ext
funext k
dsimp
by_cases h₁ : k = i₁
· subst k
simp [σ.2.1]
· by_cases h₂ : k = i₂
· subst k
simp [σ.2.2.1, hi12.symm]
· by_cases h₃ : k = i₃
· subst k
simp [σ.2.2.2, hi13.symm, hi23.symm]
· simp [h₁, h₂, h₃]
right_inv := by
intro τ
funext k
dsimp
have hk1 : k.1 ≠ i₁ := by
intro h
apply k.2
simp [C, h]
have hk2 : k.1 ≠ i₂ := by
intro h
apply k.2
simp [C, h]
have hk3 : k.1 ≠ i₃ := by
intro h
apply k.2
simp [C, h]
simp [hk1, hk2, hk3]
}
have hcard : Fintype.card {σ : Assignment n // σ i₁ = v₁ ∧ σ i₂ = v₂ ∧ σ i₃ = v₃} = 2 ^ (n - 3) := by
rw [Fintype.card_congr e]
calc
Fintype.card (Free → Bool) = 2 ^ Fintype.card Free := by
rw [Fintype.card_fun]
simp [Fintype.card_bool]
_ = 2 ^ (n - 3) := by rw [hfree]
exact hcard
Linearity of fintypeExpect for c - X on a nonempty sample space:
E[c - X] = c - E[X].
lemma fintypeExpect_sub_const {Ω : Type} [Fintype Ω] [DecidableEq Ω] (c : ℝ) (X : Ω → ℝ)
(hΩ : Fintype.card Ω ≠ 0) :
fintypeExpect (fun ω => c - X ω) = c - fintypeExpect X := by
unfold fintypeExpect
rw [Finset.sum_sub_distrib, Finset.sum_const, Finset.card_univ, nsmul_eq_mul]
have hc : (Fintype.card Ω : ℝ) ≠ 0 := by exact_mod_cast hΩ
field_simp [hc]The sum of the indicator of a predicate over a finite type is the number of its elements satisfying the predicate.
lemma sum_indicator_card {Ω : Type} [Fintype Ω] (P : Ω → Prop) [DecidablePred P] :
(∑ σ : Ω, if P σ then (1 : ℝ) else 0) = (Fintype.card {σ : Ω // P σ} : ℝ) := by
calc
(∑ σ : Ω, if P σ then (1 : ℝ) else 0) = (Finset.univ.filter P).card := by
exact_mod_cast (Finset.sum_boole P Finset.univ)
_ = (Fintype.card {σ : Ω // P σ} : ℝ) := by
exact_mod_cast (Fintype.card_of_subtype (Finset.univ.filter P) (fun σ => by simp)).symm
A uniformly random assignment leaves a valid 3-CNF clause unsatisfied with
probability exactly 1/8: its three literals are over distinct variables, so
the assignment must take the negated value at each of the three variables, and
exactly 2^(n-3) of the 2^n assignments do so (CLRS §35.4, Theorem 35.5).
lemma unsatisfied_prob (c : Finset (Literal n)) (hc : Is3CNFClause c) :
fintypeExpect (fun σ : Assignment n => indicator (ClauseUnsatisfied c σ)) = (1 : ℝ) / 8 := by
classical
rcases (Finset.card_eq_three.mp hc.1) with ⟨l₁, l₂, l₃, h12, h13, h23, hc_eq⟩
have hi12 : l₁.1 ≠ l₂.1 := hc.2 (by simp [hc_eq]) (by simp [hc_eq]) h12
have hi13 : l₁.1 ≠ l₃.1 := hc.2 (by simp [hc_eq]) (by simp [hc_eq]) h13
have hi23 : l₂.1 ≠ l₃.1 := hc.2 (by simp [hc_eq]) (by simp [hc_eq]) h23
have hun : ∀ σ : Assignment n, ClauseUnsatisfied c σ ↔
σ l₁.1 = Bool.not l₁.2 ∧ σ l₂.1 = Bool.not l₂.2 ∧ σ l₃.1 = Bool.not l₃.2 := by
intro σ
simp [ClauseUnsatisfied, litHolds, hc_eq, h12, h13, h23, bool_ne_iff_not]
have hcard : Fintype.card {σ : Assignment n // ClauseUnsatisfied c σ} = 2 ^ (n - 3) := by
have hcard3 := card_assignments_fixing_three (i₁ := l₁.1) (i₂ := l₂.1) (i₃ := l₃.1) hi12 hi13 hi23
(v₁ := Bool.not l₁.2) (v₂ := Bool.not l₂.2) (v₃ := Bool.not l₃.2)
have hcong : Fintype.card {σ : Assignment n // ClauseUnsatisfied c σ} =
Fintype.card {σ : Assignment n // σ l₁.1 = Bool.not l₁.2 ∧ σ l₂.1 = Bool.not l₂.2 ∧ σ l₃.1 = Bool.not l₃.2} := by
exact Fintype.card_congr (Equiv.subtypeEquivProp (funext fun σ => propext (hun σ)))
rwa [hcong]
unfold fintypeExpect indicator
have hsum : (∑ σ : Assignment n, if ClauseUnsatisfied c σ then (1 : ℝ) else 0) = (2 ^ (n - 3) : ℝ) := by
rw [sum_indicator_card]
exact_mod_cast hcard
have hcardA : (Fintype.card (Assignment n) : ℝ) = (2 ^ n : ℝ) := by
have hnat : Fintype.card (Assignment n) = 2 ^ n := by
rw [Fintype.card_fun]
simp [Fintype.card_bool]
exact_mod_cast hnat
rw [hsum, hcardA]
have hn : 3 ≤ n := by
have hsub : ({l₁.1, l₂.1, l₃.1} : Finset (Fin n)) ⊆ Finset.univ := Finset.subset_univ _
have hthree : ({l₁.1, l₂.1, l₃.1} : Finset (Fin n)).card = 3 := by
simp [hi12, hi13, hi23]
have hle : 3 ≤ Finset.univ.card := le_trans (by simpa [hthree]) (Finset.card_le_card hsub)
simpa using hle
have h2ne : (2 : ℝ) ≠ 0 := by norm_num
have hpow : (2 ^ (n - 3) : ℝ) * 8 = (2 ^ n : ℝ) := by
have hadd : (2 ^ (n - 3) : ℝ) * (2 ^ 3 : ℝ) = 2 ^ ((n - 3) + 3) := by rw [← pow_add]
norm_num at hadd
rwa [Nat.sub_add_cancel hn] at hadd
calc
(2 ^ (n - 3) : ℝ) / (2 ^ n : ℝ) = (2 ^ (n - 3) : ℝ) / ((2 ^ (n - 3) : ℝ) * 8) := by rw [hpow]
_ = (1 : ℝ) / 8 := by
field_simp [pow_ne_zero (n - 3) h2ne]
A uniformly random assignment satisfies a valid 3-CNF clause with
probability exactly 7/8 (CLRS §35.4, Theorem 35.5).
theorem max3cnf_clause_satisfied_prob (c : Finset (Literal n)) (hc : Is3CNFClause c) :
fintypeExpect (fun σ : Assignment n => indicator (ClauseSatisfied c σ)) = (7 : ℝ) / 8 := by
classical
have hU := unsatisfied_prob c hc
have hfunc : ∀ σ : Assignment n, indicator (ClauseSatisfied c σ) =
1 - indicator (ClauseUnsatisfied c σ) := by
intro σ
have hiff := clauseSatisfied_iff_not_unsatisfied c σ
unfold indicator
by_cases h : ClauseSatisfied c σ
· have hUσ : ¬ ClauseUnsatisfied c σ := hiff.mp h
simp [h, hUσ]
· have hUσ : ClauseUnsatisfied c σ := by
by_contra hU'
exact h (hiff.2 hU')
simp [h, hUσ]
calc
fintypeExpect (fun σ : Assignment n => indicator (ClauseSatisfied c σ))
= fintypeExpect (fun σ : Assignment n => 1 - indicator (ClauseUnsatisfied c σ)) := by
congr 1
funext σ
exact hfunc σ
_ = 1 - fintypeExpect (fun σ : Assignment n => indicator (ClauseUnsatisfied c σ)) := by
have hne : Fintype.card (Assignment n) ≠ 0 := by
have hpos : 0 < Fintype.card (Assignment n) := Fintype.card_pos_iff.mpr ⟨fun _ => true⟩
exact ne_of_gt hpos
exact fintypeExpect_sub_const (1 : ℝ) (fun σ : Assignment n => indicator (ClauseUnsatisfied c σ)) hne
_ = 1 - (1 : ℝ) / 8 := by rw [hU]
_ = (7 : ℝ) / 8 := by norm_num
The number of clauses of F satisfied by the assignment σ.
def satisfiedCount (F : Finset (Finset (Literal n))) (σ : Assignment n) : ℕ :=
(F.filter (fun c => ClauseSatisfied c σ)).card
Theorem 35.5 (expectation). For a family F of valid 3-CNF clauses, the
expected number of satisfied clauses under a uniformly random assignment is
exactly 7/8 · |F|, by linearity of expectation over the per-clause
probabilities (CLRS §35.4, Theorem 35.5).
theorem max3cnf_expect_satisfied (F : Finset (Finset (Literal n))) (hF : ∀ c ∈ F, Is3CNFClause c) :
fintypeExpect (fun σ : Assignment n => (∑ c ∈ F, indicator (ClauseSatisfied c σ) : ℝ)) =
(7 : ℝ) / 8 * (F.card : ℝ) := by
rw [fintypeExpect_sum]
have hper : ∀ c ∈ F, fintypeExpect (fun σ : Assignment n => indicator (ClauseSatisfied c σ)) = (7 : ℝ) / 8 := by
intro c hc
exact max3cnf_clause_satisfied_prob c (hF c hc)
rw [Finset.sum_congr rfl hper]
rw [Finset.sum_const, nsmul_eq_mul]
ring
Theorem 35.5. MAX-3-CNF has a randomized 8/7-approximation algorithm: for
any assignment σ₀ — in particular an optimal one — the expected number of
clauses satisfied by a uniformly random assignment is at least 7/8 of the
number that σ₀ satisfies (CLRS §35.4, Theorem 35.5).
theorem max3cnf_approx (F : Finset (Finset (Literal n))) (hF : ∀ c ∈ F, Is3CNFClause c)
(σ₀ : Assignment n) :
(7 : ℝ) / 8 * (satisfiedCount F σ₀ : ℝ) ≤
fintypeExpect (fun σ : Assignment n => (∑ c ∈ F, indicator (ClauseSatisfied c σ) : ℝ)) := by
have hle : satisfiedCount F σ₀ ≤ F.card := by
dsimp [satisfiedCount]
exact Finset.card_le_card (Finset.filter_subset _ _)
have hE := max3cnf_expect_satisfied F hF
calc
(7 : ℝ) / 8 * (satisfiedCount F σ₀ : ℝ) ≤ (7 : ℝ) / 8 * (F.card : ℝ) := by
exact mul_le_mul_of_nonneg_left (by exact_mod_cast hle) (by norm_num)
_ = fintypeExpect (fun σ : Assignment n => (∑ c ∈ F, indicator (ClauseSatisfied c σ) : ℝ)) := hE.symmLinear programming: weighted vertex cover (Theorem 35.6)
The minimum-weight vertex-cover problem takes a graph with positive vertex
weights w(v) and asks for a cover minimizing the total weight. The 0-1
integer program x(v) ∈ {0, 1} with x(u) + x(v) ≥ 1 on every edge is relaxed
to the linear program 0 ≤ x(v) ≤ 1. Any feasible solution of the IP is
feasible for the LP, so the LP optimum lower-bounds the IP optimum (the optimal
cover's weight). APPROX-MIN-WEIGHT-VC solves the LP and rounds every vertex
with x(v) ≥ 1/2 up to 1; the rounding is a vertex cover (for every edge at
least one endpoint has x ≥ 1/2) and costs at most 2 times the LP objective
(since each rounded vertex contributes w(v) ≤ 2·w(v)·x(v)).
variable {V E : Type} [DecidableEq V] [DecidableEq E] [Fintype V]
The weight of a set of vertices under the weight function w.
def vertexWeight (w : V → ℚ) (C : Finset V) : ℚ :=
∑ v ∈ C, w v
A fractional vertex cover: a vector x : V → ℚ with 0 ≤ x v ≤ 1
satisfying x(u) + x(v) ≥ 1 for every edge of E₀. This is the feasible
region of the linear-programming relaxation (CLRS §35.4, equations (35.15)-(35.18)).
def IsFractionalCover (G : ApproxVertexCover.Graph V E) (x : V → ℚ) (E₀ : Finset E) : Prop :=
(∀ v, 0 ≤ x v) ∧ (∀ v, x v ≤ 1) ∧ ∀ e ∈ E₀, x (G.src e) + x (G.dst e) ≥ 1
The LP rounding of a fractional cover: the vertices with fractional
value at least 1/2. This is the rounding step of APPROX-MIN-WEIGHT-VC
(CLRS §35.4, lines 3-5).
def roundCover (x : V → ℚ) : Finset V :=
Finset.univ.filter (fun v => (1 : ℚ) / 2 ≤ x v)
A vertex belongs to the rounding exactly when its fractional value is at
least 1/2.
lemma mem_roundCover (x : V → ℚ) (v : V) :
v ∈ roundCover x ↔ (1 : ℚ) / 2 ≤ x v := by
simp [roundCover]
Theorem 35.6 (correctness). The rounding of a fractional cover is a vertex
cover of the edge set: for every edge, at least one endpoint has fractional
value at least 1/2 (because the two values sum to at least 1).
lemma roundCover_isVertexCover (G : ApproxVertexCover.Graph V E) {x : V → ℚ} {E₀ : Finset E}
(hx : IsFractionalCover G x E₀) :
G.IsVertexCoverOn E₀ (roundCover x) := by
intro e he
have hineq : x (G.src e) + x (G.dst e) ≥ 1 := hx.2.2 e he
by_cases hsrc : (1 : ℚ) / 2 ≤ x (G.src e)
· left
exact (mem_roundCover x (G.src e)).mpr hsrc
· right
have hsrc' : x (G.src e) < (1 : ℚ) / 2 := lt_of_not_ge hsrc
have hdst : (1 : ℚ) / 2 ≤ x (G.dst e) := by
nlinarith
exact (mem_roundCover x (G.dst e)).mpr hdst
The weight of the rounded cover is at most twice the LP objective
Σ v, w(v)·x(v): each rounded vertex v has x(v) ≥ 1/2, so its weight
w(v) ≤ 2·w(v)·x(v).
lemma roundCover_weight_le (G : ApproxVertexCover.Graph V E) {w : V → ℚ} {x : V → ℚ}
{E₀ : Finset E} (hw : ∀ v, 0 < w v) (hx : IsFractionalCover G x E₀) :
vertexWeight w (roundCover x) ≤ 2 * (∑ v : V, w v * x v) := by
have hstep : ∀ v, v ∈ roundCover x → w v ≤ 2 * (w v * x v) := by
intro v hv
have hx5 : (1 : ℚ) / 2 ≤ x v := (mem_roundCover x v).mp hv
have hwpos : 0 < w v := hw v
nlinarith
have hsum1 : vertexWeight w (roundCover x) ≤ ∑ v ∈ roundCover x, 2 * (w v * x v) := by
exact Finset.sum_le_sum hstep
have hsum2 : (∑ v ∈ roundCover x, 2 * (w v * x v)) ≤ ∑ v : V, 2 * (w v * x v) := by
refine Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ _) ?_
intro v _ hvnot
exact mul_nonneg (by norm_num) (mul_nonneg (le_of_lt (hw v)) (hx.1 v))
calc
vertexWeight w (roundCover x) = ∑ v ∈ roundCover x, w v := rfl
_ ≤ ∑ v ∈ roundCover x, 2 * (w v * x v) := hsum1
_ ≤ ∑ v : V, 2 * (w v * x v) := hsum2
_ = 2 * (∑ v : V, w v * x v) := by rw [Finset.mul_sum]
Theorem 35.6. APPROX-MIN-WEIGHT-VC is a 2-approximation algorithm for the
minimum-weight vertex-cover problem: for any positive weights w, any
fractional cover x whose LP objective is at most the weight of a vertex cover
C* (in particular the LP optimum, which lower-bounds the IP optimum), the
rounded cover has weight at most 2 · w(C*) (CLRS §35.4, Theorem 35.6).
theorem approxMinWeightVC_two_approx (G : ApproxVertexCover.Graph V E) {w : V → ℚ} {x : V → ℚ}
{E₀ : Finset E} (hw : ∀ v, 0 < w v) (hx : IsFractionalCover G x E₀)
(Cstar : Finset V) (hCstar : G.IsVertexCoverOn E₀ Cstar)
(hLP : (∑ v : V, w v * x v) ≤ vertexWeight w Cstar) :
vertexWeight w (roundCover x) ≤ 2 * vertexWeight w Cstar := by
have h1 := roundCover_weight_le (G := G) hw hx
calc
vertexWeight w (roundCover x) ≤ 2 * (∑ v : V, w v * x v) := h1
_ ≤ 2 * vertexWeight w Cstar := by
exact mul_le_mul_of_nonneg_left hLP (by norm_num)end RandomizedLPend CLRSDefinitions and proofs
CLRSLean.FourthEdition.Chapter_35.Section_35_4_Randomization_And_Linear_Programming.VertexCoverLP
Vertex-cover LP construction and initialized-solver composition
The graph supplies all constraints. The initialized Chapter 29 solver produces a fractional optimum; feasibility and boundedness discharge its other outcomes. Rounding that returned vector gives a cover within twice every comparator cover. The new solver bridge uses real fractional vectors and rational input weights; the older rational-vector rounding interface is retained. This is a classical exact-real construction, without a polynomial SIMPLEX runtime claim.
noncomputable sectionnamespace CLRS.RandomizedLP.VertexCoverLPopen Finset Matrixvariable {n m : Nat} (G : ApproxVertexCover.Graph (Fin n) (Fin m))
(edges : Finset (Fin m)) (w : Fin n → ℚ)Maximize the negated cover weight under edge and upper-bound constraints.
def program : Chapter29.StandardLP (m+n) n where
A := Fin.addCases
(fun e j => if e ∈ edges then
-(if j = G.src e then 1 else 0) - (if j = G.dst e then 1 else 0) else 0)
(fun v j => if j = v then 1 else 0)
b := Fin.addCases (fun e => if e ∈ edges then -1 else 0) (fun _ => 1)
c := fun v => -(w v : ℝ)@[simp] theorem edge_row (x : Fin n → ℝ) (e : Fin m) :
((program G edges w).A *ᵥ x) (Fin.castAdd n e) =
if e ∈ edges then -(x (G.src e) + x (G.dst e)) else 0 := by
by_cases he : e ∈ edges <;>
simp [program, Matrix.mulVec, dotProduct, he, sub_mul, Finset.sum_sub_distrib]
ring@[simp] theorem upper_row (x : Fin n → ℝ) (v : Fin n) :
((program G edges w).A *ᵥ x) (Fin.natAdd m v) = x v := by
simp [program, Matrix.mulVec, dotProduct]Exact LP encoding of fractional cover constraints.
theorem feasible_iff (x : Fin n → ℝ) :
(program G edges w).IsFeasible x ↔
(∀ v, 0 ≤ x v) ∧ (∀ v, x v ≤ 1) ∧ ∀ e ∈ edges, 1 ≤ x (G.src e)+x (G.dst e) := by
constructor
· intro h
refine ⟨h.1,?_,?_⟩
· intro v
have hb := h.2 (Fin.natAdd m v)
rw [upper_row] at hb
simpa [program] using hb
· intro e he
have heq := edge_row G edges w x e
have hb := h.2 (Fin.castAdd n e)
rw [heq] at hb
simpa [program,he] using hb
· rintro ⟨hzero,hupper,hedge⟩
refine ⟨hzero,?_⟩
intro i
refine Fin.addCases (fun e => ?_) (fun v => ?_) i
· rw [edge_row]
by_cases he : e ∈ edges
· simpa [program,he] using neg_le_neg (hedge e he)
· simp [program,he]
· rw [upper_row]
simpa [program] using hupper v@[simp] theorem objective_eq (x : Fin n → ℝ) :
(program G edges w).objective x = -(∑ v, (w v : ℝ)*x v) := by
simp [Chapter29.StandardLP.objective, program, dotProduct, Finset.sum_neg_distrib]
theorem feasible_one : (program G edges w).IsFeasible (fun _ => 1) := by
rw [feasible_iff]
norm_num
theorem objective_nonpos (hw : ∀ v, 0 ≤ w v) {x : Fin n → ℝ}
(hx : (program G edges w).IsFeasible x) : (program G edges w).objective x ≤ 0 := by
rw [objective_eq]
have hs : 0 ≤ ∑ v, (w v : ℝ)*x v := by
apply Finset.sum_nonneg
intro v _
exact mul_nonneg (by exact_mod_cast hw v) (hx.1 v)
linarithInvoke initialized SIMPLEX and retain its returned optimal vector.
def solve (hw : ∀ v, 0 ≤ w v) : {x : Fin n → ℝ // (program G edges w).IsOptimal x} :=
match (program G edges w).initializedSimplex with
| .infeasible h => False.elim (h ⟨_,feasible_one G edges w⟩)
| .optimal x hx => ⟨x,hx⟩
| .unbounded h => False.elim (by
obtain ⟨x,hx,hpos⟩ := h 0
exact (not_lt_of_ge (objective_nonpos G edges w hw hx)) hpos)Round the actual returned vector at one half.
def execute (hw : ∀ v, 0 ≤ w v) : Finset (Fin n) :=
let x := solve G edges w hw
Finset.univ.filter (fun v => (1:ℝ)/2 ≤ x.val v)theorem execute_isVertexCover (hw : ∀ v, 0 ≤ w v) :
G.IsVertexCoverOn edges (execute G edges w hw) := by
intro e he
have hx := (feasible_iff G edges w _).mp (solve G edges w hw).property.1
have hedge := hx.2.2 e he
simp only [execute, Finset.mem_filter, Finset.mem_univ, true_and]
by_cases h : (1:ℝ)/2 ≤ (solve G edges w hw).val (G.src e)
· exact Or.inl h
· right
push Not at h
linarithEvery integral comparator cover gives a feasible LP vector.
theorem indicator_feasible (C : Finset (Fin n)) (hC : G.IsVertexCoverOn edges C) :
(program G edges w).IsFeasible (fun v => if v ∈ C then 1 else 0) := by
rw [feasible_iff]
refine ⟨?_,?_,?_⟩
· intro v; split_ifs <;> norm_num
· intro v; split_ifs <;> norm_num
· intro e he
rcases hC e he with hs | hd
· simp only [hs, if_true]; split_ifs <;> norm_num
· simp only [hd, if_true]; split_ifs <;> norm_numThe bound against every integral cover follows from the returned optimum.
theorem solve_weight_le (hw : ∀ v, 0 ≤ w v)
(C : Finset (Fin n)) (hC : G.IsVertexCoverOn edges C) :
(∑ v, (w v : ℝ)*(solve G edges w hw).val v) ≤ ∑ v ∈ C, (w v : ℝ) := by
have h := (solve G edges w hw).property.2 _ (indicator_feasible G edges w C hC)
simp only [objective_eq] at h
have hi : (∑ v, (w v : ℝ)*(if v ∈ C then 1 else 0)) = ∑ v ∈ C, (w v : ℝ) := by
simp [mul_ite, Finset.sum_ite_mem]
rw [hi] at h
linarithThreshold rounding costs at most twice the returned fractional objective.
theorem execute_weight_le_fractional (hw : ∀ v, 0 ≤ w v) :
(∑ v ∈ execute G edges w hw, (w v : ℝ)) ≤
2 * ∑ v, (w v : ℝ)*(solve G edges w hw).val v := by
have hx := (solve G edges w hw).property.1.1
have hstep : ∀ v ∈ execute G edges w hw,
(w v : ℝ) ≤ 2*((w v : ℝ)*(solve G edges w hw).val v) := by
intro v hv
have hv' : (1:ℝ)/2 ≤ (solve G edges w hw).val v := by
simpa [execute] using hv
have hw' : (0:ℝ) ≤ w v := by exact_mod_cast hw v
nlinarith
calc
_ ≤ ∑ v ∈ execute G edges w hw, 2*((w v : ℝ)*(solve G edges w hw).val v) :=
Finset.sum_le_sum hstep
_ ≤ ∑ v, 2*((w v : ℝ)*(solve G edges w hw).val v) := by
apply Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ _)
intro v _ _
exact mul_nonneg (by norm_num) (mul_nonneg (by exact_mod_cast hw v) (hx v))
_ = _ := by rw [Finset.mul_sum]Graph-to-solver-to-rounded-cover factor two, without a supplied LP bound.
theorem execute_two_approx (hw : ∀ v, 0 ≤ w v)
(C : Finset (Fin n)) (hC : G.IsVertexCoverOn edges C) :
vertexWeight w (execute G edges w hw) ≤ 2 * vertexWeight w C := by
have hr := execute_weight_le_fractional G edges w hw
have ho := solve_weight_le G edges w hw C hC
have h : (∑ v ∈ execute G edges w hw, (w v : ℝ)) ≤ 2*∑ v ∈ C, (w v : ℝ) := by
linarith
unfold vertexWeight
exact_mod_cast hThe same returned set satisfies feasibility and the approximation guarantee.
theorem execute_correct (hw : ∀ v, 0 ≤ w v)
(C : Finset (Fin n)) (hC : G.IsVertexCoverOn edges C) :
G.IsVertexCoverOn edges (execute G edges w hw) ∧
vertexWeight w (execute G edges w hw) ≤ 2*vertexWeight w C :=
⟨execute_isVertexCover G edges w hw,execute_two_approx G edges w hw C hC⟩end CLRS.RandomizedLP.VertexCoverLPImports
import Mathlib35.5. The Subset-Sum Problem
The costed execution records the work of the executable approximation scheme.
This section formalizes the subset-sum problem and the fully polynomial-time
approximation scheme APPROX-SUBSET-SUM of CLRS §35.5. Given a finite set
S = {x₁, ..., xₙ} of positive integers and a target t, the subset-sum
problem asks for the subset whose sum is as large as possible without exceeding
t. The exact algorithm EXACT-SUBSET-SUM builds the sorted list of all
achievable subset sums at most t (its last element is the optimum), but its
lists can grow to size 2^n. The approximation scheme instead trims each
list so that consecutive kept sums differ by a factor of 1 + δ, retaining a
(1 + δ)-representative for every removed value; trimming at each level with
δ = ε/(2n) accumulates only a (1 + ε)-factor of error over all n levels.
Main results:
-
Definition
subsetSums: the set of all subset sums of a list of integers, built by the same merge step as EXACT-SUBSET-SUM (Lᵢ = Lᵢ₋₁ ∪ (Lᵢ₋₁ + xᵢ)). -
Definition
exactLists: the output list of EXACT-SUBSET-SUM — the subset sums ofSnot exceedingt. -
Definition
optimalSum: the largest achievable subset sum at mostt(the optimumy*). -
Definition
merge: the merge of two sorted lists of sums. -
Definition
trim/trimAux: the greedy TRIM of a sorted list with parameterδ, keeping the first element and then every element exceeding(1 + δ)times the last kept element. -
Lemma
trim_rep(Lemma 35.5): every element of the trimmed list's input is represented within a factor(1 + δ)by a kept element — for everyyin a sortedLthere iszintrim δ Lwithz ≤ y ≤ (1 + δ) · z. -
Definition
approxLists: the trimmed listsLᵢof APPROX-SUBSET-SUM. -
Lemma
approxLists_subset_subsetSums: every value on the trimmed lists is still an achievable subset sum at mostt(trimming never introduces or loses validity). -
Lemma
approxLists_prefix_rep: afterilevels of trimming with parameterδ, every achievable sumy ≤ tof the firstielements has a representativezinLᵢwithy ≤ (1 + δ)^i · zandz ≤ y(the compounded per-level factor, Exercise 35.5-2). -
Theorem
approxSubsetSum_approx(Theorem 35.7): APPROX-SUBSET-SUM returns a valid subset sumz* ≤ twith the explicit boundy* ≤ (1 + ε/(2n))^n · z*. -
Theorem
approxSubsetSum_approx_lt(Theorem 35.7): with0 < ε ≤ 1, the explicit factor is absorbed into(1 + ε)via(1 + ε/(2n))^n ≤ e^{ε/2} ≤ 1 + ε, givingy* ≤ (1 + ε) · z*. -
Definition
Separated: a list is(1 + δ)-separated when everyabeforebsatisfies(1 + δ) · a < b. -
Lemma
trim_separated: TRIM returns a(1 + δ)-separated list (the premise of Exercise 35.5-1). -
Lemma
sep_length_bound(Exercise 35.5-1): a(1 + δ)-separated list of naturals in[1, t]has at mostlog t / log(1 + δ) + 1elements. -
Lemma
approxLists_length_bound: every trimmed list of APPROX-SUBSET-SUM has at mostlog t / log(1 + δ) + 2elements (including the least element0). -
Theorem
approxSubsetSum_fptas(Theorem 35.8): withδ = ε/(2n), every trimmed list has at most4n · lg t / ε + 2elements, so APPROX-SUBSET-SUM runs in time polynomial in the input size and in1/ε— a fully polynomial-time approximation scheme.
Current gaps: none. The running-time analysis of Theorem 35.8 is formalized at the mathematical level (list-size bounds); a machine-level cost model assigning running times to MERGE-LISTS and TRIM steps is not modeled.
Notation conventions used in this section:
-
xs/ps: a list of positive integers (the setS, ordered for the algorithm); subset sums are order-independent -
s,y: a candidate subset sum -
t: the target sum -
δ: the trim parameter (0 ≤ δ) -
ε: the approximation parameter (0 < ε ≤ 1), withδ = ε/(2n) -
L,M: sorted lists of sums -
y*: the optimal subset sum (optimalSum) -
z*: the value returned by APPROX-SUBSET-SUM (approxSum)
noncomputable sectionopen scoped BigOperatorsopen scoped Listopen Finsetnamespace CLRSnamespace ApproxSubsetSumThe subset-sum problem and EXACT-SUBSET-SUM
CLRS models the set S = {x₁, ..., xₙ} of positive integers and builds the
lists Lᵢ of all sums obtainable from subsets of {x₁, ..., xᵢ}, discarding
every sum exceeding the target t. The recurrence
Lᵢ = Lᵢ₋₁ ∪ (Lᵢ₋₁ + xᵢ) is captured by the recursive definition of
subsetSums; exactLists adds the pruning of sums above t and optimalSum
is the largest element of the pruned list.
The set of all subset sums of a list xs of integers. The recursion
subsetSums (x :: xs) = subsetSums xs ∪ (subsetSums xs) + x is exactly the
merge step of EXACT-SUBSET-SUM (CLRS §35.5, line 2).
def subsetSums : List ℕ → Finset ℕ
| [] => {0}
| x :: xs => subsetSums xs ∪ (subsetSums xs).image (fun s => s + x)
The empty subset has sum 0, so 0 is always an achievable sum.
lemma zero_mem_subsetSums (xs : List ℕ) : 0 ∈ subsetSums xs := by
induction xs with
| nil => simp [subsetSums]
| cons x xs ih => simp [subsetSums, ih]
A sum of x :: xs is either a sum of xs alone or a sum of xs plus
x. This is the CLRS recurrence Lᵢ = Lᵢ₋₁ ∪ (Lᵢ₋₁ + xᵢ).
lemma mem_subsetSums_cons {x : ℕ} {xs : List ℕ} {s : ℕ} :
s ∈ subsetSums (x :: xs) ↔ s ∈ subsetSums xs ∨ ∃ t ∈ subsetSums xs, t + x = s := by
simp [subsetSums]
Every sum of xs is also a sum of x :: xs (drop the new element).
lemma subsetSums_cons_subset {x : ℕ} {xs : List ℕ} : subsetSums xs ⊆ subsetSums (x :: xs) := by
intro s hs
simp [subsetSums, hs]
If z is a sum of xs, then z + x is a sum of x :: xs.
lemma mem_subsetSums_add {x : ℕ} {xs : List ℕ} {z : ℕ} :
z ∈ subsetSums xs → z + x ∈ subsetSums (x :: xs) := by
intro hz
change z + x ∈ subsetSums xs ∪ (subsetSums xs).image (fun s => s + x)
rw [Finset.mem_union]
right
rw [Finset.mem_image]
exact ⟨z, hz, rfl⟩
The output of EXACT-SUBSET-SUM(S, t): the set of all subset sums of S
not exceeding the target t (CLRS §35.5, EXACT-SUBSET-SUM line 5).
def exactLists (xs : List ℕ) (t : ℕ) : Finset ℕ :=
(subsetSums xs).filter (fun s => s ≤ t)
The exact list is nonempty: 0 is always achievable and 0 ≤ t.
lemma exactLists_nonempty (xs : List ℕ) (t : ℕ) : (exactLists xs t).Nonempty := by
exact ⟨0, by simp [exactLists, zero_mem_subsetSums xs, Nat.zero_le]⟩
The optimal subset sum y*: the largest achievable subset sum of xs
not exceeding t. It is well-defined because 0 is always achievable and
0 ≤ t.
def optimalSum (xs : List ℕ) (t : ℕ) : ℕ :=
(exactLists xs t).max' (exactLists_nonempty xs t)The optimum is an achievable subset sum.
lemma optimalSum_mem_subsetSums (xs : List ℕ) (t : ℕ) : optimalSum xs t ∈ subsetSums xs := by
exact (Finset.mem_filter.mp (Finset.max'_mem (exactLists xs t) (exactLists_nonempty xs t))).1
The optimum does not exceed the target t.
lemma optimalSum_le_t (xs : List ℕ) (t : ℕ) : optimalSum xs t ≤ t := by
exact (Finset.mem_filter.mp (Finset.max'_mem (exactLists xs t) (exactLists_nonempty xs t))).2
The optimum of the empty list is 0.
lemma optimalSum_nil (t : ℕ) : optimalSum [] t = 0 := by
rw [optimalSum]
apply le_antisymm
· apply Finset.max'_le
intro y hy
simp [exactLists, subsetSums] at hy
exact le_of_eq hy.1
· apply Finset.le_max'
simp [exactLists, subsetSums, Nat.zero_le]The merge of two sorted lists
APPROX-SUBSET-SUM keeps the lists sorted so that TRIM can scan them greedily.
merge is the merge of two sorted lists of sums (CLRS MERGE-LISTS).
The merge of two sorted lists of natural numbers.
def merge : List ℕ → List ℕ → List ℕ
| [], ys => ys
| xs, [] => xs
| x :: xs, y :: ys => if x ≤ y then x :: merge xs (y :: ys) else y :: merge (x :: xs) ys
An element of the merged list is an element of one of the inputs (and
vice versa): merge returns the union of its inputs.
lemma mem_merge {L M : List ℕ} {z : ℕ} : z ∈ merge L M ↔ z ∈ L ∨ z ∈ M := by
induction L generalizing M with
| nil => simp [merge]
| cons x xs ihL =>
induction M with
| nil => simp [merge]
| cons y ys ihM =>
by_cases hxy : x ≤ y
· simp [merge, hxy]
rw [ihL]
simp
tauto
· simp [merge, hxy]
rw [ihM]
simp
tautoThe merge of two sorted lists is sorted.
lemma merge_sorted (L M : List ℕ) (hL : L.Pairwise (· ≤ ·)) (hM : M.Pairwise (· ≤ ·)) :
(merge L M).Pairwise (· ≤ ·) := by
induction L generalizing M with
| nil => simpa [merge] using hM
| cons x xs ihL =>
induction M with
| nil => simpa [merge] using hL
| cons y ys ihM =>
by_cases hxy : x ≤ y
· have hsub : ∀ z ∈ merge xs (y :: ys), x ≤ z := by
intro z hz
rw [mem_merge] at hz
rcases hz with hz | hz
· exact (List.pairwise_cons.mp hL).1 z hz
· simp at hz
rcases hz with hz | hz
· subst z
exact hxy
· exact le_trans hxy ((List.pairwise_cons.mp hM).1 z hz)
have hsort : (merge xs (y :: ys)).Pairwise (· ≤ ·) := by
exact ihL (y :: ys) (List.pairwise_cons.mp hL).2 hM
simpa [merge, hxy] using (List.pairwise_cons.mpr ⟨hsub, hsort⟩)
· have hle : y ≤ x := le_of_not_ge hxy
have hsub : ∀ z ∈ merge (x :: xs) ys, y ≤ z := by
intro z hz
rw [mem_merge] at hz
rcases hz with hz | hz
· simp at hz
rcases hz with hz | hz
· subst z
exact hle
· exact le_trans hle ((List.pairwise_cons.mp hL).1 z hz)
· exact (List.pairwise_cons.mp hM).1 z hz
have hsort : (merge (x :: xs) ys).Pairwise (· ≤ ·) := by
exact ihM (List.pairwise_cons.mp hM).2
simpa [merge, hxy] using (List.pairwise_cons.mpr ⟨hsub, hsort⟩)Adding a constant to every element of a sorted list keeps it sorted.
lemma map_add_pairwise (x : ℕ) {L : List ℕ} (hL : L.Pairwise (· ≤ ·)) :
(L.map (fun s => s + x)).Pairwise (· ≤ ·) := by
exact List.Pairwise.map (fun s => s + x) (by intro a b h; exact Nat.add_le_add_right h x) hLTRIM and Lemma 35.5
TRIM scans a sorted list in increasing order and keeps the first element, then
keeps an element y only when (1 + δ) · last < y, where last is the last
kept element; otherwise y is within a factor (1 + δ) of last and is
dropped. Lemma 35.5 states the invariant: every element of the input list has
a kept representative within a factor (1 + δ) below it.
The greedy tail scan of TRIM: with the previously kept element last,
keeps y iff (1 + δ) · last < y, otherwise recurses keeping last.
def trimAux (δ : ℝ) : ℕ → List ℕ → List ℕ
| last, [] => []
| last, y :: ys =>
if (1 + δ) * (last : ℝ) < (y : ℝ) then
y :: trimAux δ y ys
else
trimAux δ last ys
The TRIM of a sorted list L with parameter δ (CLRS §35.5,
TRIM(L, δ)): keeps the first element and then every element exceeding
(1 + δ) times the last kept element.
def trim (δ : ℝ) : List ℕ → List ℕ
| [] => []
| y :: ys => y :: trimAux δ y ysEvery element of a trimmed tail was an element of that tail.
lemma trimAux_mem_subset (δ : ℝ) : ∀ (last : ℕ) {ys : List ℕ} {z : ℕ},
z ∈ trimAux δ last ys → z ∈ ys := by
intro last ys z hz
induction ys generalizing last with
| nil => simp [trimAux] at hz
| cons y ys ih =>
by_cases hkeep : (1 + δ) * (last : ℝ) < (y : ℝ)
· simp [trimAux, hkeep] at hz
rcases hz with hz | hz
· subst z
simp
· exact List.mem_cons.mpr (Or.inr (ih y hz))
· simp [trimAux, hkeep] at hz
exact List.mem_cons.mpr (Or.inr (ih last hz))Every kept element of TRIM was an element of the input list.
lemma mem_trim_subset (δ : ℝ) {L : List ℕ} {z : ℕ} (hz : z ∈ trim δ L) : z ∈ L := by
cases L with
| nil => simp [trim] at hz
| cons y ys =>
simp [trim] at hz
rcases hz with hz | hz
· subst z
simp
· exact List.mem_cons.mpr (Or.inr (trimAux_mem_subset δ y hz))The tail scan of TRIM returns a sublist of the scanned tail.
lemma trimAux_sublist (δ : ℝ) : ∀ (last : ℕ) (ys : List ℕ), trimAux δ last ys <+ ys := by
intro last ys
induction ys generalizing last with
| nil => simp [trimAux]
| cons y ys ih =>
by_cases hkeep : (1 + δ) * (last : ℝ) < (y : ℝ)
· have hsub : trimAux δ y ys <+ ys := ih y
simpa [trimAux, hkeep] using hsub.cons_cons y
· simpa [trimAux, hkeep] using (ih last).cons yTRIM returns a sublist of its input list.
lemma trim_sublist (δ : ℝ) : ∀ L : List ℕ, trim δ L <+ L := by
intro L
cases L with
| nil => simp [trim]
| cons y ys =>
have hsub : trimAux δ y ys <+ ys := trimAux_sublist δ y ys
simpa [trim] using hsub.cons_cons yTRIM keeps a subsequence of a sorted list, so its output is sorted.
lemma trim_sorted {δ : ℝ} {L : List ℕ} (hL : L.Pairwise (· ≤ ·)) : (trim δ L).Pairwise (· ≤ ·) := by
exact List.Pairwise.sublist (trim_sublist δ L) hL
The tail scan represents every element of the scanned tail: for every y
in the tail, some z among the tail scan's output plus the reference last
satisfies z ≤ y ≤ (1 + δ) · z. This is the induction core of Lemma 35.5.
lemma trimAux_rep {δ : ℝ} (hδ : 0 ≤ δ) :
∀ (last : ℕ) {ys : List ℕ}, ys.Pairwise (· ≤ ·) →
(∀ y ∈ ys, (last : ℝ) ≤ (y : ℝ)) →
∀ y ∈ ys, ∃ z ∈ last :: trimAux δ last ys,
(z : ℝ) ≤ (y : ℝ) ∧ (y : ℝ) ≤ (1 + δ) * (z : ℝ) := by
intro last ys
induction ys generalizing last with
| nil => intro hys hle y hy; simp at hy
| cons x xs ih =>
intro hys hle y hy
simp at hy
rcases hy with hy | hy
· subst y
by_cases hkeep : (1 + δ) * (last : ℝ) < (x : ℝ)
· refine ⟨x, by simp [trimAux, hkeep], ?_⟩
have hx0 : (0 : ℝ) ≤ (x : ℝ) := by exact_mod_cast Nat.zero_le x
constructor
· rfl
· nlinarith
· refine ⟨last, by simp [trimAux, hkeep], ?_⟩
have hlastx : (last : ℝ) ≤ (x : ℝ) := by exact_mod_cast (hle x (by simp))
exact ⟨hlastx, le_of_not_gt hkeep⟩
· by_cases hkeep : (1 + δ) * (last : ℝ) < (x : ℝ)
· rcases (ih x (List.pairwise_cons.mp hys).2
(by intro z hz; exact_mod_cast (List.pairwise_cons.mp hys).1 z hz) y hy) with ⟨z, hz, hlo, hhi⟩
exact ⟨z, by simp [trimAux, hkeep, hz], hlo, hhi⟩
· rcases (ih last (List.pairwise_cons.mp hys).2
(by intro z hz; exact_mod_cast (hle z (by simp [hz]))) y hy) with ⟨z, hz, hlo, hhi⟩
exact ⟨z, by simp [trimAux, hkeep, hz], hlo, hhi⟩
Lemma 35.5 (TRIM). For a sorted list L and δ ≥ 0, every element y of
L is represented in TRIM(L, δ) by some z with z ≤ y ≤ (1 + δ) · z: a
kept element represents itself and a dropped element is within a factor
(1 + δ) of the last kept element below it (CLRS §35.5, Lemma 35.5).
lemma trim_rep {δ : ℝ} (hδ : 0 ≤ δ) {L : List ℕ} (hL : L.Pairwise (· ≤ ·)) :
∀ y ∈ L, ∃ z ∈ trim δ L, (z : ℝ) ≤ (y : ℝ) ∧ (y : ℝ) ≤ (1 + δ) * (z : ℝ) := by
induction L with
| nil => intro y hy; simp at hy
| cons x xs ih =>
intro y hy
simp at hy
rcases hy with hy | hy
· subst y
refine ⟨x, by simp [trim], ?_⟩
have hx0 : (0 : ℝ) ≤ (x : ℝ) := by exact_mod_cast Nat.zero_le x
constructor
· rfl
· nlinarith
· rcases (trimAux_rep hδ x (List.pairwise_cons.mp hL).2
(by intro z hz; exact_mod_cast (List.pairwise_cons.mp hL).1 z hz) y hy)
with ⟨z, hz, hlo, hhi⟩
exact ⟨z, by simp [trim, hz], hlo, hhi⟩APPROX-SUBSET-SUM and its approximation guarantee
APPROX-SUBSET-SUM runs the exact algorithm but inserts Lᵢ ← TRIM(Lᵢ, ε/(2n))
after each merge and then drops every element exceeding t; it returns the
largest element z* of the final list. The trimmed lists never lose a value
beyond a compounded (1 + ε/(2n))^i factor, which gives Theorem 35.7.
The trimmed lists Lᵢ of APPROX-SUBSET-SUM: after processing the whole
list, every element exceeding t is dropped. approxLists δ t xs is the
final list Lₙ for S = xs with trim parameter δ.
def approxLists (δ : ℝ) (t : ℕ) : List ℕ → List ℕ
| [] => [0]
| x :: xs =>
let L := approxLists δ t xs
(trim δ (merge L (L.map (fun s => s + x)))).filter (fun s => s ≤ t)The trimmed lists stay sorted.
lemma approxLists_sorted (δ : ℝ) (t : ℕ) : ∀ xs : List ℕ, (approxLists δ t xs).Pairwise (· ≤ ·) := by
intro xs
induction xs with
| nil => simp [approxLists]
| cons x xs ih =>
have hmerge : (merge (approxLists δ t xs) ((approxLists δ t xs).map (fun s => s + x))).Pairwise (· ≤ ·) :=
merge_sorted _ _ ih (map_add_pairwise x ih)
have htrim : (trim δ (merge (approxLists δ t xs) ((approxLists δ t xs).map (fun s => s + x)))).Pairwise (· ≤ ·) :=
trim_sorted hmerge
have hfilter : ((trim δ (merge (approxLists δ t xs) ((approxLists δ t xs).map (fun s => s + x)))).filter (fun s => s ≤ t)).Pairwise (· ≤ ·) :=
List.Pairwise.filter (fun s => s ≤ t) htrim
simpa [approxLists] using hfilter
If 0 belongs to a sorted list, TRIM keeps it (it is the least element,
hence the head).
lemma zero_mem_trim {δ : ℝ} {L : List ℕ} (hL : L.Pairwise (· ≤ ·)) (h0 : 0 ∈ L) :
0 ∈ trim δ L := by
cases L with
| nil => simp at h0
| cons y ys =>
have hy0 : y = 0 := by
simp at h0
rcases h0 with h0 | h0
· exact h0.symm
· have hyz : y ≤ 0 := (List.pairwise_cons.mp hL).1 0 h0
exact le_antisymm hyz (Nat.zero_le y)
subst y
simp [trim]
0 is always present on the trimmed lists (the empty subset is never
lost and never exceeds the target).
lemma zero_mem_approxLists (δ : ℝ) (t : ℕ) (xs : List ℕ) : 0 ∈ approxLists δ t xs := by
induction xs with
| nil => simp [approxLists]
| cons x xs ih =>
have h0L : 0 ∈ approxLists δ t xs := ih
have h0merged : 0 ∈ merge (approxLists δ t xs) ((approxLists δ t xs).map (fun s => s + x)) := by
exact (mem_merge).2 (Or.inl h0L)
have h0trim : 0 ∈ trim δ (merge (approxLists δ t xs) ((approxLists δ t xs).map (fun s => s + x))) := by
exact zero_mem_trim
(merge_sorted _ _ (approxLists_sorted δ t xs) (map_add_pairwise x (approxLists_sorted δ t xs))) h0merged
exact List.mem_filter.mpr ⟨h0trim, by simp⟩Every value on the trimmed lists is an achievable subset sum of the input list (TRIM only drops values and MERGE only combines existing values), so APPROX-SUBSET-SUM never returns a sum that is not a subset sum.
lemma approxLists_subset_subsetSums (δ : ℝ) (t : ℕ) :
∀ xs : List ℕ, ∀ z ∈ approxLists δ t xs, z ∈ subsetSums xs := by
intro xs
induction xs with
| nil => intro z hz; simp [approxLists] at hz; subst z; simp [subsetSums]
| cons x xs ih =>
intro z hz
simp [approxLists] at hz
rcases hz with ⟨hztrim, hzle⟩
have hzmerge : z ∈ merge (approxLists δ t xs) ((approxLists δ t xs).map (fun s => s + x)) :=
mem_trim_subset δ hztrim
rw [mem_merge] at hzmerge
rcases hzmerge with hzL | hzLx
· exact subsetSums_cons_subset (ih z hzL)
· rcases (List.mem_map.mp hzLx) with ⟨s, hsL, hs⟩
subst z
exact mem_subsetSums_add (ih s hsL)
Every value on the trimmed lists is at most the target t (they pass the
≤ t filter of APPROX-SUBSET-SUM).
lemma mem_approxLists_le_t (δ : ℝ) (t : ℕ) :
∀ xs : List ℕ, ∀ z ∈ approxLists δ t xs, z ≤ t := by
intro xs
induction xs with
| nil => intro z hz; simp [approxLists] at hz; subst z; exact Nat.zero_le t
| cons x xs ih =>
intro z hz
simp [approxLists] at hz
exact hz.2
After i levels of trimming with parameter δ, every achievable sum
y ≤ t of the first i elements has a representative z in Lᵢ with
y ≤ (1 + δ)^i · z and z ≤ y. Each level of TRIM contributes one factor
(1 + δ); the factor compounds over the i merges (CLRS §35.5,
Exercise 35.5-2).
lemma approxLists_prefix_rep {δ : ℝ} (hδ : 0 ≤ δ) (t : ℕ) :
∀ ps : List ℕ, ∀ y ∈ subsetSums ps, y ≤ t →
∃ z ∈ approxLists δ t ps,
((y : ℝ) ≤ (1 + δ) ^ ps.length * (z : ℝ)) ∧ ((z : ℝ) ≤ (y : ℝ)) := by
intro ps
induction ps with
| nil =>
intro y hy hle
have hy0 : y = 0 := by
simpa [subsetSums] using hy
subst y
refine ⟨0, by simp [approxLists], ?_⟩
simp
| cons x xs ih =>
intro y hy hle
rcases (mem_subsetSums_cons.mp hy) with hyxs | ⟨s, hsxs, hs⟩
· rcases (ih y hyxs hle) with ⟨z0, hz0, hlo0, hhi0⟩
have hz0merged : z0 ∈ merge (approxLists δ t xs) ((approxLists δ t xs).map (fun s => s + x)) := by
exact (mem_merge).2 (Or.inl hz0)
rcases (trim_rep hδ
(merge_sorted _ _ (approxLists_sorted δ t xs) (map_add_pairwise x (approxLists_sorted δ t xs)))
z0 hz0merged) with ⟨z, hztrim, hzle_z0, hz0_le⟩
have hzle_t : z ≤ t := by
exact le_trans (by exact_mod_cast (hzle_z0.trans hhi0)) hle
refine ⟨z, by simp [approxLists, hztrim, hzle_t], ?_⟩
constructor
· rw [List.length_cons]
have hpow0 : 0 ≤ (1 + δ) ^ xs.length := pow_nonneg (by linarith) _
have hscale : (1 + δ) ^ xs.length * (z0 : ℝ) ≤ (1 + δ) ^ xs.length * ((1 + δ) * (z : ℝ)) := by
exact mul_le_mul_of_nonneg_left hz0_le hpow0
calc
(y : ℝ) ≤ (1 + δ) ^ xs.length * (z0 : ℝ) := hlo0
_ ≤ (1 + δ) ^ xs.length * ((1 + δ) * (z : ℝ)) := hscale
_ = (1 + δ) ^ (xs.length + 1) * (z : ℝ) := by
rw [pow_succ]
ring
· exact hzle_z0.trans hhi0
· subst y
have hsle : s ≤ t := by omega
rcases (ih s hsxs hsle) with ⟨z0, hz0, hlo0, hhi0⟩
let w : ℕ := z0 + x
have hwmerged : w ∈ merge (approxLists δ t xs) ((approxLists δ t xs).map (fun s => s + x)) := by
apply (mem_merge).2
right
exact List.mem_map.mpr ⟨z0, hz0, rfl⟩
rcases (trim_rep hδ
(merge_sorted _ _ (approxLists_sorted δ t xs) (map_add_pairwise x (approxLists_sorted δ t xs)))
w hwmerged) with ⟨z, hztrim, hzle_w, hw_le⟩
have hzle_t : z ≤ t := by
have hwy : w ≤ s + x := by
dsimp [w]
exact Nat.add_le_add_right (by exact_mod_cast hhi0) x
exact le_trans (by exact_mod_cast (hzle_w.trans (by exact_mod_cast hwy : (w : ℝ) ≤ (s + x : ℝ)))) hle
refine ⟨z, by simp [approxLists, hztrim, hzle_t], ?_⟩
constructor
· rw [List.length_cons]
have hpow0 : 0 ≤ (1 + δ) ^ xs.length := pow_nonneg (by linarith) _
have hpowge1 : (1 : ℝ) ≤ (1 + δ) ^ xs.length := by
simpa using (pow_le_pow_left₀ (a := (1 : ℝ)) (b := (1 + δ)) (by norm_num) (by linarith) xs.length)
have hzx_le : (z0 : ℝ) + (x : ℝ) ≤ (1 + δ) * (z : ℝ) := by
have hw_eq : (z0 : ℝ) + (x : ℝ) = (w : ℝ) := by
exact_mod_cast (show z0 + x = w by rfl)
rw [hw_eq]
exact hw_le
have hxscale : (x : ℝ) ≤ (1 + δ) ^ xs.length * (x : ℝ) := by
exact le_mul_of_one_le_left (by exact_mod_cast Nat.zero_le x) hpowge1
have hz0x_le : (1 + δ) ^ xs.length * (z0 : ℝ) + (x : ℝ) ≤ (1 + δ) ^ xs.length * ((z0 : ℝ) + (x : ℝ)) := by
nlinarith [hxscale]
calc
↑(s + x) ≤ (1 + δ) ^ xs.length * (z0 : ℝ) + (x : ℝ) := by
have hdist : ↑(s + x) = (s : ℝ) + (x : ℝ) := by norm_num
rw [hdist]
simpa [add_comm] using add_le_add_right hlo0 (x : ℝ)
_ ≤ (1 + δ) ^ xs.length * ((z0 : ℝ) + (x : ℝ)) := hz0x_le
_ ≤ (1 + δ) ^ xs.length * ((1 + δ) * (z : ℝ)) := by
exact mul_le_mul_of_nonneg_left hzx_le hpow0
_ = (1 + δ) ^ (xs.length + 1) * (z : ℝ) := by
rw [pow_succ]
ring
· have hwy : w ≤ s + x := by
dsimp [w]
exact Nat.add_le_add_right (by exact_mod_cast hhi0) x
exact (by exact_mod_cast hzle_w : (z : ℝ) ≤ (w : ℝ)).trans (by exact_mod_cast hwy)
The value z* returned by APPROX-SUBSET-SUM(S, t, ε): the largest
element of the final trimmed list, computed with trim parameter ε/(2n)
(CLRS §35.5, APPROX-SUBSET-SUM line 8).
def approxSum (xs : List ℕ) (t : ℕ) (ε : ℝ) : ℕ :=
((approxLists (ε / (2 * (xs.length : ℝ))) t xs).toFinset).max' (by
exact ⟨0, by simpa [zero_mem_approxLists]⟩)
The value z* belongs to the final trimmed list of APPROX-SUBSET-SUM.
lemma approxSum_mem (xs : List ℕ) (t : ℕ) (ε : ℝ) :
approxSum xs t ε ∈ approxLists (ε / (2 * (xs.length : ℝ))) t xs := by
have hm : approxSum xs t ε ∈ (approxLists (ε / (2 * (xs.length : ℝ))) t xs).toFinset := by
dsimp [approxSum]
exact Finset.max'_mem (approxLists (ε / (2 * (xs.length : ℝ))) t xs).toFinset
(by exact ⟨0, by simp [zero_mem_approxLists]⟩)
simpa using hm
The value returned for the empty list is 0.
lemma approxSum_nil (t : ℕ) (ε : ℝ) : approxSum [] t ε = 0 := by
simp [approxSum, approxLists]
APPROX-SUBSET-SUM returns a value z* that is an achievable subset sum:
z* ∈ subsetSums xs (Theorem 35.7, correctness).
lemma approxSum_mem_subsetSums (xs : List ℕ) (t : ℕ) (ε : ℝ) :
approxSum xs t ε ∈ subsetSums xs := by
exact approxLists_subset_subsetSums (ε / (2 * (xs.length : ℝ))) t xs (approxSum xs t ε)
(approxSum_mem xs t ε)
APPROX-SUBSET-SUM returns a value z* not exceeding the target t
(Theorem 35.7, correctness).
lemma approxSum_le_t (xs : List ℕ) (t : ℕ) (ε : ℝ) : approxSum xs t ε ≤ t := by
exact mem_approxLists_le_t (ε / (2 * (xs.length : ℝ))) t xs (approxSum xs t ε)
(approxSum_mem xs t ε)
Theorem 35.7 (explicit factor). APPROX-SUBSET-SUM(S, t, ε) returns a value
z* such that the optimum y* satisfies
y* ≤ (1 + ε/(2n))^n · z*, where n = |S|. This is the compounded
(1 + ε/(2n))^n representation error over all n trimming levels (CLRS §35.5,
Theorem 35.7).
theorem approxSubsetSum_approx (xs : List ℕ) (t : ℕ) (ε : ℝ) (hε : 0 ≤ ε) :
(optimalSum xs t : ℝ) ≤
(1 + ε / (2 * (xs.length : ℝ))) ^ xs.length * (approxSum xs t ε : ℝ) := by
let δ : ℝ := ε / (2 * (xs.length : ℝ))
have hδ : 0 ≤ δ := by
dsimp [δ]
exact div_nonneg hε (by positivity)
have hrep := approxLists_prefix_rep (δ := δ) (hδ := hδ) t xs
rcases hrep (optimalSum xs t) (optimalSum_mem_subsetSums xs t) (optimalSum_le_t xs t)
with ⟨z, hz, hlo, hhi⟩
have hzle : (z : ℝ) ≤ (approxSum xs t ε : ℝ) := by
have hzs : z ∈ (approxLists (ε / (2 * (xs.length : ℝ))) t xs).toFinset := by
simpa [δ] using hz
have hzleN : z ≤ approxSum xs t ε := by
exact Finset.le_max' (approxLists (ε / (2 * (xs.length : ℝ))) t xs).toFinset z hzs
exact_mod_cast hzleN
have hpow0 : 0 ≤ (1 + δ) ^ xs.length := pow_nonneg (by linarith) _
calc
(optimalSum xs t : ℝ) ≤ (1 + δ) ^ xs.length * (z : ℝ) := hlo
_ ≤ (1 + δ) ^ xs.length * (approxSum xs t ε : ℝ) := by
exact mul_le_mul_of_nonneg_left hzle hpow0
The (1 + ε) bound (Theorem 35.7, final form)
To reach the clean (1 + ε) factor of CLRS Theorem 35.7, the compounded error
(1 + ε/(2n))^n must be absorbed: since (1 + ε/(2n)) ≤ e^{ε/(2n)}, raising to
the n-th power gives (1 + ε/(2n))^n ≤ e^{ε/2}, and e^{ε/2} ≤ 1 + ε for
0 ≤ ε ≤ 1.
For 0 ≤ ε ≤ 1, (1 + ε/(2n))^n ≤ 1 + ε: the compounded per-level error
(1 + ε/(2n))^n of the n trims is bounded by e^{ε/2} ≤ 1 + ε
(CLRS §35.5, inequalities (35.26)-(35.29)).
lemma pow_one_add_half_le_one_add {ε : ℝ} {n : ℕ} (hε0 : 0 ≤ ε) (hε1 : ε ≤ 1) :
(1 + ε / (2 * (n : ℝ))) ^ n ≤ 1 + ε := by
by_cases hn : n = 0
· subst n
simp [hε0]
· have hstep1 : (1 + ε / (2 * (n : ℝ))) ^ n ≤ Real.exp (ε / 2) := by
have hδnz : 0 ≤ 1 + ε / (2 * (n : ℝ)) := by positivity
have hbase : 1 + ε / (2 * (n : ℝ)) ≤ Real.exp (ε / (2 * (n : ℝ))) := by
simpa [add_comm] using (Real.add_one_le_exp (ε / (2 * (n : ℝ))))
have hpow : (1 + ε / (2 * (n : ℝ))) ^ n ≤ (Real.exp (ε / (2 * (n : ℝ)))) ^ n := by
exact pow_le_pow_left₀ hδnz hbase n
have htwo : (2 * (n : ℝ)) ≠ 0 := by
exact_mod_cast (show (2 * n : ℕ) ≠ 0 by omega)
calc
(1 + ε / (2 * (n : ℝ))) ^ n ≤ (Real.exp (ε / (2 * (n : ℝ)))) ^ n := hpow
_ = Real.exp (n * (ε / (2 * (n : ℝ)))) := by rw [Real.exp_nat_mul]
_ = Real.exp (ε / 2) := by
congr 1
field_simp [htwo]
have hstep2 : Real.exp (ε / 2) ≤ 1 + ε := by
have hx0 : 0 ≤ ε / 2 := by linarith
have hx1 : ε / 2 ≤ 1 := by linarith
have hx2 : |ε / 2| ≤ 1 := by
rw [abs_of_nonneg hx0]
exact hx1
have hb := Real.abs_exp_sub_one_sub_id_le (x := ε / 2) hx2
have hb' : Real.exp (ε / 2) - 1 - ε / 2 ≤ (ε / 2) ^ 2 := (abs_le.mp hb).2
have hexp : Real.exp (ε / 2) ≤ 1 + ε / 2 + (ε / 2) ^ 2 := by linarith
have hsq : (ε / 2) ^ 2 ≤ ε / 2 := by
have hmul := mul_le_mul_of_nonneg_left hx1 hx0
nlinarith
have htail : 1 + ε / 2 + (ε / 2) ^ 2 ≤ 1 + ε := by
nlinarith [hsq]
exact le_trans hexp htail
exact le_trans hstep1 hstep2
Theorem 35.7. For 0 < ε ≤ 1, APPROX-SUBSET-SUM(S, t, ε) is a
(1 + ε)-approximation of the subset-sum problem: the optimum y* satisfies
y* ≤ (1 + ε) · z* for the returned value z* (CLRS §35.5, Theorem 35.7).
theorem approxSubsetSum_approx_lt (xs : List ℕ) (t : ℕ) (ε : ℝ)
(hε0 : 0 < ε) (hε1 : ε ≤ 1) :
(optimalSum xs t : ℝ) ≤ (1 + ε) * (approxSum xs t ε : ℝ) := by
by_cases hn : xs.length = 0
· have hlen : xs = [] := by simpa using hn
subst xs
rw [optimalSum_nil, approxSum_nil]
simp
· have hεnz : 0 ≤ ε := le_of_lt hε0
have hpow := pow_one_add_half_le_one_add (ε := ε) (n := xs.length) hεnz hε1
have hmain := approxSubsetSum_approx xs t ε hεnz
have hz0 : 0 ≤ (approxSum xs t ε : ℝ) := by exact_mod_cast Nat.zero_le (approxSum xs t ε)
calc
(optimalSum xs t : ℝ) ≤ (1 + ε / (2 * (xs.length : ℝ))) ^ xs.length * (approxSum xs t ε : ℝ) := hmain
_ ≤ (1 + ε) * (approxSum xs t ε : ℝ) := by
exact mul_le_mul_of_nonneg_right hpow hz0The running-time analysis (Theorem 35.8, FPTAS)
The approximation guarantee of Theorem 35.7 shows APPROX-SUBSET-SUM is a
(1 + ε)-approximation; to see that it is a fully polynomial-time scheme the
size of the trimmed lists must be bounded. TRIM keeps consecutive kept values
more than a multiplicative factor 1 + δ apart, so a (1 + δ)-separated list
with every value in [1, t] has at most log t / log(1 + δ) + 1 elements
(Exercise 35.5-1). With δ = ε/(2n) and the chord bound log(1 + δ) ≥ δ/2,
each list has O(n · lg t / ε) elements; since MERGE-LISTS and TRIM each cost
linear time in the list length, the whole algorithm runs in time
O(n² · lg t / ε), polynomial in the input size and in 1/ε. This is
Theorem 35.8: APPROX-SUBSET-SUM is a fully polynomial-time approximation
scheme.
A list is (1 + δ)-separated when every a occurring before b
satisfies (1 + δ) · a < b: the kept values of TRIM stay more than a
multiplicative factor 1 + δ apart.
def Separated (δ : ℝ) (L : List ℕ) : Prop :=
L.Pairwise (fun a b : ℕ => (1 + δ) * (a : ℝ) < (b : ℝ))
TRIM's tail scan keeps the previously kept element last followed by the
kept tail; every kept value is more than a factor (1 + δ) above every earlier
kept value.
lemma trimAux_separated {δ : ℝ} (hδ : 0 ≤ δ) :
∀ last ys, Separated δ (last :: trimAux δ last ys) := by
intro last ys
induction ys generalizing last with
| nil => simp [Separated, trimAux]
| cons y ys ih =>
by_cases hkeep : (1 + δ) * (last : ℝ) < (y : ℝ)
· have htail : Separated δ (y :: trimAux δ y ys) := ih y
rw [trimAux, if_pos hkeep]
apply List.pairwise_cons.mpr
constructor
· intro z hz
rcases List.mem_cons.mp hz with hz | hz
· subst z
exact hkeep
· have hsep : (1 + δ) * (y : ℝ) < (z : ℝ) := (List.pairwise_cons.mp htail).1 z hz
have hy0 : (0 : ℝ) ≤ (y : ℝ) := by exact_mod_cast Nat.zero_le y
have hδy : (0 : ℝ) ≤ δ * (y : ℝ) := mul_nonneg hδ hy0
have hle : (y : ℝ) ≤ (1 + δ) * (y : ℝ) := by nlinarith
exact lt_trans hkeep (lt_of_le_of_lt hle hsep)
· exact htail
· simpa [trimAux, hkeep] using ih last
TRIM produces a (1 + δ)-separated list: every kept value exceeds every
earlier kept value by more than a factor 1 + δ.
lemma trim_separated {δ : ℝ} (hδ : 0 ≤ δ) : ∀ L : List ℕ, Separated δ (trim δ L) := by
intro L
cases L with
| nil => simp [Separated, trim]
| cons y ys => simpa [trim] using (trimAux_separated hδ y ys)Filtering a separated list keeps it separated (a sublist of a separated list is separated).
lemma separated_filter {δ : ℝ} {L : List ℕ} (p : ℕ → Prop) [DecidablePred p]
(h : Separated δ L) : Separated δ (L.filter p) := by
unfold Separated at *
exact List.Pairwise.sublist List.filter_sublist h
The trimmed lists of APPROX-SUBSET-SUM are (1 + δ)-separated.
lemma approxLists_separated {δ : ℝ} (hδ : 0 ≤ δ) (t : ℕ) :
∀ xs, Separated δ (approxLists δ t xs) := by
intro xs
induction xs with
| nil => simp [approxLists, Separated]
| cons x xs ih =>
dsimp [approxLists]
exact separated_filter (fun s => s ≤ t)
(trim_separated hδ (merge (approxLists δ t xs) ((approxLists δ t xs).map (fun s => s + x))))
The counting core of Exercise 35.5-1: a (1 + δ)-separated list of naturals
whose elements lie in the real interval [c, t] has at most
log(t / c) / log(1 + δ) + 1 elements.
lemma sep_length_aux {δ t : ℝ} (hδ : 0 < δ) (c : ℝ) (hc : 1 ≤ c) (hct : c ≤ t) :
∀ L : List ℕ, Separated δ L →
(∀ a ∈ L, c ≤ (a : ℝ)) →
(∀ a ∈ L, (a : ℝ) ≤ t) →
(L.length : ℝ) ≤ Real.log (t / c) / Real.log (1 + δ) + 1 := by
intro L
induction L generalizing c hc hct with
| nil =>
intro hsep hlo hle
have hc0 : 0 < c := lt_of_lt_of_le zero_lt_one hc
have h1 : (1 : ℝ) ≤ t / c := by
rw [le_div_iff₀ hc0]
simpa using hct
have hlg : 0 < Real.log (1 + δ) := Real.log_pos (by linarith)
have hlg0 : (0 : ℝ) ≤ Real.log (t / c) / Real.log (1 + δ) :=
div_nonneg (Real.log_nonneg h1) (le_of_lt hlg)
have hz : (0 : ℝ) ≤ Real.log (t / c) / Real.log (1 + δ) + 1 := by linarith [hlg0]
simpa using hz
| cons a rest ih =>
intro hsep hlo hle
have hsepR : Separated δ rest := (List.pairwise_cons.mp hsep).2
have hleR : ∀ b ∈ rest, (b : ℝ) ≤ t := by
intro b hb
exact hle b (by simp [hb])
have ha_c : c ≤ (a : ℝ) := hlo a (by simp)
have hla : (1 : ℝ) ≤ (a : ℝ) := le_trans hc ha_c
have ha0 : (0 : ℝ) < (a : ℝ) := lt_of_lt_of_le zero_lt_one hla
have hc0 : 0 < c := lt_of_lt_of_le zero_lt_one hc
have ht0 : 0 < t := lt_of_lt_of_le hc0 hct
have hlg : 0 < Real.log (1 + δ) := Real.log_pos (by linarith)
cases rest with
| nil =>
have h1 : (1 : ℝ) ≤ t / c := by
rw [le_div_iff₀ hc0]
simpa using hct
have hlg0 : (0 : ℝ) ≤ Real.log (t / c) / Real.log (1 + δ) :=
div_nonneg (Real.log_nonneg h1) (le_of_lt hlg)
have : (1 : ℝ) ≤ Real.log (t / c) / Real.log (1 + δ) + 1 := by linarith [hlg0]
simpa using this
| cons b rest' =>
let c' : ℝ := (1 + δ) * (a : ℝ)
have hδ0 : 0 ≤ δ := le_of_lt hδ
have hc'1 : (1 : ℝ) ≤ c' := by
dsimp [c']
have hδa : (0 : ℝ) ≤ δ * (a : ℝ) := mul_nonneg hδ0 (by exact_mod_cast Nat.zero_le a)
nlinarith
have hc't : c' ≤ t := by
have hsep_b : (1 + δ) * (a : ℝ) < (b : ℝ) :=
List.rel_of_pairwise_cons hsep (by simp)
have hb_t : (b : ℝ) ≤ t := hle b (by simp)
dsimp [c']
nlinarith
have hbc' : ∀ y ∈ b :: rest', c' ≤ (y : ℝ) := by
intro y hy
have hsep_y : (1 + δ) * (a : ℝ) < (y : ℝ) :=
List.rel_of_pairwise_cons hsep (by simpa using hy)
dsimp [c']
exact le_of_lt hsep_y
have hc'0 : 0 < c' := lt_of_lt_of_le zero_lt_one hc'1
have hloga : Real.log c ≤ Real.log (a : ℝ) := by
apply Real.log_le_log
· exact hc0
· exact ha_c
have hlogc' : Real.log c' = Real.log (1 + δ) + Real.log (a : ℝ) := by
dsimp [c']
rw [Real.log_mul (ne_of_gt (by linarith : (0 : ℝ) < 1 + δ)) (ne_of_gt ha0)]
have hlt : Real.log (1 + δ) ≤ Real.log c' - Real.log c := by
nlinarith [hloga, hlogc']
have hlogtc' : Real.log (t / c') = Real.log t - Real.log c' := by
rw [Real.log_div (ne_of_gt ht0) (ne_of_gt hc'0)]
have hlogtc : Real.log (t / c) = Real.log t - Real.log c := by
rw [Real.log_div (ne_of_gt ht0) (ne_of_gt hc0)]
have hmain : Real.log (1 + δ) + Real.log (t / c') ≤ Real.log (t / c) := by
rw [hlogtc', hlogtc]
nlinarith [hlt]
have hgoal : (1 : ℝ) + Real.log (t / c') / Real.log (1 + δ) ≤
Real.log (t / c) / Real.log (1 + δ) := by
have hmul : (1 + Real.log (t / c') / Real.log (1 + δ)) * Real.log (1 + δ) ≤
Real.log (t / c) := by
field_simp [ne_of_gt hlg]
exact hmain
exact (le_div_iff₀ hlg).mpr hmul
have hm : (((b :: rest').length : ℝ) ≤ Real.log (t / c') / Real.log (1 + δ) + 1) :=
ih c' hc'1 hc't hsepR hbc' hleR
have hres : ((a :: b :: rest').length : ℝ) ≤
Real.log (t / c) / Real.log (1 + δ) + 1 := by
have htail' : ((a :: b :: rest').length : ℝ) =
((b :: rest').length : ℝ) + 1 := by
simp
rw [htail']
nlinarith [hm, hgoal]
simpa using hres
Exercise 35.5-1 (list size). A (1 + δ)-separated list of naturals with
every element in [1, t] has at most ⌊log_{1+δ} t⌋ + 1 elements; here the
real-valued bound log t / log(1 + δ) + 1 (CLRS §35.5, Exercise 35.5-1).
lemma sep_length_bound {δ : ℝ} (hδ : 0 < δ) (t : ℕ) (ht : 1 ≤ t) {L : List ℕ}
(hsep : Separated δ L)
(hpos : ∀ a ∈ L, (1 : ℝ) ≤ (a : ℝ))
(hle : ∀ a ∈ L, (a : ℝ) ≤ (t : ℝ)) :
(L.length : ℝ) ≤ Real.log (t : ℝ) / Real.log (1 + δ) + 1 := by
have h := sep_length_aux hδ 1 (by norm_num) (by exact_mod_cast ht) L hsep hpos hle
simpa using h
In a sorted list containing 0, the head is 0.
lemma sorted_zero_head {L : List ℕ} (hsorted : L.Pairwise (· ≤ ·)) (h0 : 0 ∈ L) :
L = 0 :: L.tail := by
cases L with
| nil => simp at h0
| cons a rest =>
have ha : a = 0 := by
by_contra hna
have h0rest : 0 ∈ rest := by
simp at h0
rcases h0 with h0 | h0
· exact False.elim (hna h0.symm)
· exact h0
have ha0 : a ≤ 0 := (List.pairwise_cons.mp hsorted).1 0 h0rest
omega
subst a
rfl
In a (1 + δ)-separated list starting with 0, the tail is exactly the
filter of the non-zero elements.
lemma cons_zero_filter {δ : ℝ} {rest : List ℕ} (hsep : Separated δ (0 :: rest)) :
(0 :: rest).filter (fun a => a ≠ 0) = rest := by
have hne : ∀ z ∈ rest, z ≠ 0 := by
intro z hz
have hzsep : (1 + δ) * (0 : ℝ) < (z : ℝ) := by
simpa [Separated] using List.rel_of_pairwise_cons hsep (by simpa using hz)
intro hz0
rw [hz0] at hzsep
norm_num at hzsep
rw [List.filter_cons_of_neg]
· rw [List.filter_eq_self]
intro z hz
exact by simp [hne z hz]
· simp
The positive elements of each trimmed list of APPROX-SUBSET-SUM number at
most log t / log(1 + δ) + 1 (Exercise 35.5-1).
lemma approxLists_pos_length_bound {δ : ℝ} (hδ : 0 < δ) (t : ℕ) (ht : 1 ≤ t) :
∀ xs, (((approxLists δ t xs).filter (fun a => a ≠ 0)).length : ℝ) ≤
Real.log (t : ℝ) / Real.log (1 + δ) + 1 := by
intro xs
refine sep_length_bound hδ t ht ?_ ?_ ?_
· exact separated_filter (fun a => a ≠ 0) (approxLists_separated (le_of_lt hδ) t xs)
· intro a ha
exact_mod_cast (Nat.succ_le_of_lt (Nat.pos_of_ne_zero (of_decide_eq_true (List.mem_filter.mp ha).2)))
· intro a ha
exact_mod_cast (mem_approxLists_le_t δ t xs a (List.mem_filter.mp ha).1)
Each trimmed list of APPROX-SUBSET-SUM has at most
log t / log(1 + δ) + 2 elements: the (1 + δ)-separated positive values
number at most log t / log(1 + δ) + 1, and 0 contributes one more.
lemma approxLists_length_bound {δ : ℝ} (hδ : 0 < δ) (t : ℕ) (ht : 1 ≤ t) :
∀ xs, ((approxLists δ t xs).length : ℝ) ≤ Real.log (t : ℝ) / Real.log (1 + δ) + 2 := by
intro xs
have hsep : Separated δ (approxLists δ t xs) := approxLists_separated (le_of_lt hδ) t xs
have hhead : approxLists δ t xs = 0 :: (approxLists δ t xs).tail :=
sorted_zero_head (approxLists_sorted δ t xs) (zero_mem_approxLists δ t xs)
have htail : (approxLists δ t xs).filter (fun a => a ≠ 0) = (approxLists δ t xs).tail := by
rw [hhead]
have hsep0 : Separated δ (0 :: (approxLists δ t xs).tail) := by
rw [← hhead]
exact hsep
exact cons_zero_filter hsep0
have hpos : (((approxLists δ t xs).filter (fun a => a ≠ 0)).length : ℝ) ≤
Real.log (t : ℝ) / Real.log (1 + δ) + 1 :=
approxLists_pos_length_bound hδ t ht xs
rw [htail] at hpos
rw [hhead]
have hlen : ((0 :: (approxLists δ t xs).tail).length : ℝ) =
((approxLists δ t xs).tail.length : ℝ) + 1 := by
simp
rw [hlen]
linarith
For 0 ≤ δ ≤ 1, δ / 2 ≤ log(1 + δ): the chord bound that turns the
log t / log(1 + δ) list size into O(lg t / δ).
lemma log_one_add_ge_half {δ : ℝ} (hδ0 : 0 ≤ δ) (hδ1 : δ ≤ 1) : δ / 2 ≤ Real.log (1 + δ) := by
have hx0 : 0 < 1 + δ := by linarith
have hx2 : 0 < 1 - δ / 2 := by linarith
have hle : Real.log (1 / (1 + δ)) ≤ Real.log (1 - δ / 2) := by
apply Real.log_le_log
· positivity
· rw [div_le_iff₀ hx0]
nlinarith
have hsub : Real.log (1 - δ / 2) ≤ -(δ / 2) := by
have h := Real.log_le_sub_one_of_pos hx2
nlinarith
have hloginv : Real.log (1 + δ) = -Real.log (1 / (1 + δ)) := by
have h : Real.log (1 + δ)⁻¹ = -Real.log (1 + δ) := Real.log_inv (1 + δ)
have hdiv : 1 / (1 + δ) = (1 + δ)⁻¹ := by ring
rw [← hdiv] at h
linarith
nlinarith [hle, hsub, hloginv]
Theorem 35.8 (FPTAS running time). APPROX-SUBSET-SUM(S, t, ε) is a fully
polynomial-time approximation scheme: with δ = ε/(2n) (n = |S|), every
trimmed list has at most 4n · lg t / ε + 2 elements — O(n · lg t / ε) —
and since MERGE-LISTS and TRIM each cost linear time in the list length, the
whole algorithm runs in time O(n² · lg t / ε), polynomial in the input size
and in 1/ε (CLRS §35.5, Theorem 35.8; the list-size bound is Exercise
35.5-1).
theorem approxSubsetSum_fptas {xs : List ℕ} {t : ℕ} {ε : ℝ}
(hε0 : 0 < ε) (hε1 : ε ≤ 1) (ht : 1 ≤ t) :
((approxLists (ε / (2 * (xs.length : ℝ))) t xs).length : ℝ) ≤
(4 * (xs.length : ℝ) * Real.log (t : ℝ)) / ε + 2 := by
let δ : ℝ := ε / (2 * (xs.length : ℝ))
by_cases hn0 : xs.length = 0
· have hxs : xs = [] := List.eq_nil_of_length_eq_zero hn0
subst xs
simp [approxLists, δ]
· have hnpos : 0 < (xs.length : ℝ) := by exact_mod_cast (Nat.pos_of_ne_zero hn0)
have hn1 : (1 : ℝ) ≤ (xs.length : ℝ) := by exact_mod_cast (Nat.succ_le_of_lt (Nat.pos_of_ne_zero hn0))
have hδ0 : 0 < δ := by
dsimp [δ]
exact div_pos hε0 (by positivity)
have hδle : δ ≤ 1 := by
dsimp [δ]
have h2n : (1 : ℝ) ≤ 2 * (xs.length : ℝ) := by nlinarith [hn1]
have hεlen : ε ≤ 2 * (xs.length : ℝ) := le_trans hε1 h2n
exact (div_le_iff₀ (by positivity : (0 : ℝ) < 2 * (xs.length : ℝ))).mpr (by simpa using hεlen)
have hlogpos : 0 < Real.log (1 + δ) := Real.log_pos (by linarith)
have hlogt : 0 ≤ Real.log (t : ℝ) := Real.log_nonneg (by exact_mod_cast ht)
have hlogd : δ / 2 ≤ Real.log (1 + δ) := log_one_add_ge_half (le_of_lt hδ0) hδle
have hscaled : Real.log (t : ℝ) / Real.log (1 + δ) ≤
4 * (xs.length : ℝ) * Real.log (t : ℝ) / ε := by
have hδ2 : 0 < δ / 2 := by positivity
have hinv : (Real.log (1 + δ))⁻¹ ≤ (δ / 2)⁻¹ := (inv_le_inv₀ hlogpos hδ2).2 hlogd
have hδ2inv : (δ / 2)⁻¹ = 4 * (xs.length : ℝ) / ε := by
have h2d : (2 : ℝ) / δ = 4 * (xs.length : ℝ) / ε := by
dsimp [δ]
field_simp [hε0.ne', ne_of_gt hnpos]
ring
calc
(δ / 2)⁻¹ = 2 / δ := by field_simp [ne_of_gt hδ0]
_ = 4 * (xs.length : ℝ) / ε := h2d
calc
Real.log (t : ℝ) / Real.log (1 + δ) = Real.log (t : ℝ) * (Real.log (1 + δ))⁻¹ := by ring
_ ≤ Real.log (t : ℝ) * (δ / 2)⁻¹ := mul_le_mul_of_nonneg_left hinv hlogt
_ = Real.log (t : ℝ) * (4 * (xs.length : ℝ) / ε) := by rw [hδ2inv]
_ = 4 * (xs.length : ℝ) * Real.log (t : ℝ) / ε := by ring
have hlen := approxLists_length_bound (δ := δ) hδ0 t ht xs
have hfinal : Real.log (t : ℝ) / Real.log (1 + δ) + 2 ≤
4 * (xs.length : ℝ) * Real.log (t : ℝ) / ε + 2 := by
nlinarith [hscaled]
have hgoal' : ((approxLists δ t xs).length : ℝ) ≤
4 * (xs.length : ℝ) * Real.log (t : ℝ) / ε + 2 := by
exact le_trans hlen hfinal
simpa [δ] using hgoal'end ApproxSubsetSumend CLRSDefinitions and proofs
CLRSLean.FourthEdition.Chapter_35.Section_35_5_The_Subset_Sum_Problem.Costed.Bounds
CLRS Section 35.5 - Work bounds for costed APPROX-SUBSET-SUM
The bounds in this file concern the counters produced by the concrete
execution in Costed.Execution. The model charges one unit for each list
addition, comparison, or outer-loop composition step.
noncomputable sectionnamespace CLRSnamespace ApproxSubsetSum
Every intermediate list is bounded using the one trimming parameter
selected from the original input length n. In particular, the parameter is
not recomputed from the length of the remaining suffix.
theorem approxLists_uniform_length_bound {n t : Nat} {ε : Real}
(hn : 0 < n) (hε0 : 0 < ε) (hε1 : ε ≤ 1) (ht : 1 ≤ t) (ys : List Nat) :
((approxLists (ε / (2 * (n : Real))) t ys).length : Real) ≤
4 * (n : Real) * Real.log (t : Real) / ε + 2 := by
let δ : Real := ε / (2 * (n : Real))
have hnpos : 0 < (n : Real) := by exact_mod_cast hn
have hn1 : (1 : Real) ≤ (n : Real) := by exact_mod_cast hn
have hδ0 : 0 < δ := by
dsimp [δ]
exact div_pos hε0 (by positivity)
have hδle : δ ≤ 1 := by
dsimp [δ]
have h2n : (1 : Real) ≤ 2 * (n : Real) := by nlinarith [hn1]
have hεn : ε ≤ 2 * (n : Real) := le_trans hε1 h2n
exact (div_le_iff₀ (by positivity : (0 : Real) < 2 * (n : Real))).mpr
(by simpa using hεn)
have hlogpos : 0 < Real.log (1 + δ) := Real.log_pos (by linarith)
have hlogt : 0 ≤ Real.log (t : Real) :=
Real.log_nonneg (by exact_mod_cast ht)
have hlogd : δ / 2 ≤ Real.log (1 + δ) :=
log_one_add_ge_half (le_of_lt hδ0) hδle
have hscaled : Real.log (t : Real) / Real.log (1 + δ) ≤
4 * (n : Real) * Real.log (t : Real) / ε := by
have hδ2 : 0 < δ / 2 := by positivity
have hinv : (Real.log (1 + δ))⁻¹ ≤ (δ / 2)⁻¹ :=
(inv_le_inv₀ hlogpos hδ2).2 hlogd
have hδ2inv : (δ / 2)⁻¹ = 4 * (n : Real) / ε := by
have h2d : (2 : Real) / δ = 4 * (n : Real) / ε := by
dsimp [δ]
field_simp [hε0.ne', ne_of_gt hnpos]
ring
calc
(δ / 2)⁻¹ = 2 / δ := by field_simp [ne_of_gt hδ0]
_ = 4 * (n : Real) / ε := h2d
calc
Real.log (t : Real) / Real.log (1 + δ) =
Real.log (t : Real) * (Real.log (1 + δ))⁻¹ := by ring
_ ≤ Real.log (t : Real) * (δ / 2)⁻¹ :=
mul_le_mul_of_nonneg_left hinv hlogt
_ = Real.log (t : Real) * (4 * (n : Real) / ε) := by rw [hδ2inv]
_ = 4 * (n : Real) * Real.log (t : Real) / ε := by ring
have hlen := approxLists_length_bound (δ := δ) hδ0 t ht ys
have hfinal : Real.log (t : Real) / Real.log (1 + δ) + 2 ≤
4 * (n : Real) * Real.log (t : Real) / ε + 2 := by
linarith
have hgoal : ((approxLists δ t ys).length : Real) ≤
4 * (n : Real) * Real.log (t : Real) / ε + 2 :=
le_trans hlen hfinal
simpa [δ] using hgoalThe five local scans performed in one outer iteration use at most seven times the prior list length.
private theorem localPipeline_work_le (δ : Real) (t x : Nat) (L : List Nat) :
let shifted := mapAddWithCost x L
let merged := mergeWithCost L shifted.value
let trimmed := trimWithCost δ merged.value
let kept := filterAtMostWithCost t trimmed.value
shifted.work + merged.work + trimmed.work + kept.work ≤ 7 * L.length := by
dsimp only
have hshiftWork := mapAddWithCost_work x L
have hshiftLen : (mapAddWithCost x L).value.length = L.length := by
rw [mapAddWithCost_value]
simp
have hmergeWork := mergeWithCost_work_le L (mapAddWithCost x L).value
have hmergeLen := mergeWithCost_length L (mapAddWithCost x L).value
have htrimWork :=
trimWithCost_work_le δ (mergeWithCost L (mapAddWithCost x L).value).value
have htrimLen :=
trimWithCost_length_le δ (mergeWithCost L (mapAddWithCost x L).value).value
have hfilterWork := filterAtMostWithCost_work t
(trimWithCost δ (mergeWithCost L (mapAddWithCost x L).value).value).value
omega
If all semantic intermediate lists are bounded by B, the actual outer
execution counter is at most length * (7B + 1).
theorem approxListsWithCost_work_le_of_length_bound {δ B : Real} {t : Nat}
(_hB : 0 ≤ B)
(hbound : ∀ ys, ((approxLists δ t ys).length : Real) ≤ B) (xs : List Nat) :
((approxListsWithCost δ t xs).work : Real) ≤
(xs.length : Real) * (7 * B + 1) := by
induction xs with
| nil => simp [approxListsWithCost]
| cons x xs ih =>
let prior := approxListsWithCost δ t xs
let shifted := mapAddWithCost x prior.value
let merged := mergeWithCost prior.value shifted.value
let trimmed := trimWithCost δ merged.value
let kept := filterAtMostWithCost t trimmed.value
have hprior : (prior.work : Real) ≤ (xs.length : Real) * (7 * B + 1) := by
simpa [prior] using ih
have hlen : (prior.value.length : Real) ≤ B := by
rw [approxListsWithCost_value]
exact hbound xs
have hpipeline :
shifted.work + merged.work + trimmed.work + kept.work ≤
7 * prior.value.length := by
simpa [shifted, merged, trimmed, kept] using
localPipeline_work_le δ t x prior.value
have hpipelineReal :
((shifted.work + merged.work + trimmed.work + kept.work : Nat) : Real) ≤
7 * (prior.value.length : Real) := by
exact_mod_cast hpipeline
push_cast at hpipelineReal
have hstep :
((shifted.work + merged.work + trimmed.work + kept.work + 1 : Nat) : Real) ≤
7 * B + 1 := by
push_cast
nlinarith
rw [approxListsWithCost]
dsimp only
change ((prior.work + shifted.work + merged.work + trimmed.work + kept.work + 1 : Nat) : Real) ≤
(((xs.length + 1 : Nat) : Real) * (7 * B + 1))
push_cast
push_cast at hstep
ring_nf at hprior hstep ⊢
nlinarith
The counter returned by the complete execution is polynomial in the input
length, log t, and 1 / ε. The bound includes construction of every
intermediate list and the final maximum scan.
theorem approxSubsetSumWithCost_work_le {xs : List Nat} {t : Nat} {ε : Real}
(hε0 : 0 < ε) (hε1 : ε ≤ 1) (ht : 1 ≤ t) :
((approxSubsetSumWithCost xs t ε).work : Real) ≤
48 * ((xs.length : Real) + 1) ^ 2 *
(Real.log (t : Real) + 1) / ε := by
have hlog : 0 ≤ Real.log (t : Real) :=
Real.log_nonneg (by exact_mod_cast ht)
by_cases hnil : xs = []
· subst xs
have hratio : 1 ≤ (Real.log (t : Real) + 1) / ε := by
apply (le_div_iff₀ hε0).2
linarith
have h48 : (0 : Real) ≤ 48 := by norm_num
simp only [List.length_nil, Nat.cast_zero, zero_add, one_pow]
rw [approxSubsetSumWithCost]
simp [approxListsWithCost, maximumWithCost, maximumAuxWithCost]
calc
(1 : Real) ≤ 48 := by norm_num
_ ≤ 48 * ((Real.log (t : Real) + 1) / ε) :=
by simpa using mul_le_mul_of_nonneg_left hratio h48
_ = 48 * (Real.log (t : Real) + 1) / ε := by ring
· have hn : 0 < xs.length := by
exact Nat.pos_of_ne_zero (fun hlen => hnil (List.eq_nil_of_length_eq_zero hlen))
let n : Real := xs.length
let B : Real := 4 * n * Real.log (t : Real) / ε + 2
have hn0 : 0 ≤ n := by positivity
have hn1 : 1 ≤ n := by
dsimp [n]
exact_mod_cast hn
have hB0 : 0 ≤ B := by
dsimp [B]
have : 0 ≤ 4 * n * Real.log (t : Real) / ε := by positivity
linarith
have hbound : ∀ ys,
((approxLists (ε / (2 * (xs.length : Real))) t ys).length : Real) ≤ B := by
intro ys
simpa [B, n] using
(approxLists_uniform_length_bound (n := xs.length) hn hε0 hε1 ht ys)
have hlists := approxListsWithCost_work_le_of_length_bound
(δ := ε / (2 * (xs.length : Real))) (B := B) hB0 hbound xs
have hvalueLen :
((approxListsWithCost (ε / (2 * (xs.length : Real))) t xs).value.length : Real) ≤ B := by
rw [approxListsWithCost_value]
exact hbound xs
have htotal :
((approxSubsetSumWithCost xs t ε).work : Real) ≤
n * (7 * B + 1) + B := by
rw [approxSubsetSumWithCost]
simp only
rw [maximumWithCost_work]
push_cast
simpa [n] using add_le_add hlists hvalueLen
have hBstep : B ≤ 7 * B + 1 := by nlinarith
have hcoarse :
((approxSubsetSumWithCost xs t ε).work : Real) ≤
(n + 1) * (7 * B + 1) := by
calc
((approxSubsetSumWithCost xs t ε).work : Real)
≤ n * (7 * B + 1) + B := htotal
_ ≤ n * (7 * B + 1) + (7 * B + 1) := add_le_add_right hBstep _
_ = (n + 1) * (7 * B + 1) := by ring
have hnlog : n * Real.log (t : Real) ≤
(n + 1) * (Real.log (t : Real) + 1) := by
nlinarith [mul_nonneg hn0 hlog]
have hεprod : ε ≤ (n + 1) * (Real.log (t : Real) + 1) := by
have hone : 1 ≤ (n + 1) * (Real.log (t : Real) + 1) := by
nlinarith [mul_nonneg hn0 hlog]
exact le_trans hε1 hone
have hinside :
28 * n * Real.log (t : Real) + 15 * ε ≤
48 * (n + 1) * (Real.log (t : Real) + 1) := by
nlinarith
have hpoly : (n + 1) * (7 * B + 1) ≤
48 * (n + 1) ^ 2 * (Real.log (t : Real) + 1) / ε := by
have hleft : (n + 1) * (7 * B + 1) =
((n + 1) * (28 * n * Real.log (t : Real) + 15 * ε)) / ε := by
dsimp [B]
field_simp [hε0.ne']
ring
rw [hleft]
apply (div_le_div_iff_of_pos_right hε0).2
have hmul := mul_le_mul_of_nonneg_left hinside (by linarith : 0 ≤ n + 1)
nlinarith
simpa [n] using le_trans hcoarse hpolyKernel-checked FPTAS bundle for the costed execution: feasibility, approximation quality, and polynomial work all refer to the same run.
theorem approxSubsetSumWithCost_fptas {xs : List Nat} {t : Nat} {ε : Real}
(hε0 : 0 < ε) (hε1 : ε ≤ 1) (ht : 1 ≤ t) :
let run := approxSubsetSumWithCost xs t ε
run.value ∈ subsetSums xs ∧
run.value ≤ t ∧
(optimalSum xs t : Real) ≤ (1 + ε) * (run.value : Real) ∧
(run.work : Real) ≤
48 * ((xs.length : Real) + 1) ^ 2 *
(Real.log (t : Real) + 1) / ε := by
dsimp only
refine ⟨?_, ?_, ?_, approxSubsetSumWithCost_work_le hε0 hε1 ht⟩
· rw [approxSubsetSumWithCost_value]
exact approxSum_mem_subsetSums xs t ε
· rw [approxSubsetSumWithCost_value]
exact approxSum_le_t xs t ε
· rw [approxSubsetSumWithCost_value]
exact approxSubsetSum_approx_lt xs t ε hε0 hε1end ApproxSubsetSumend CLRSCLRSLean.FourthEdition.Chapter_35.Section_35_5_The_Subset_Sum_Problem.Costed.Definitions
CLRS Section 35.5 - Costed local scans
Execution records for the concrete list passes used by APPROX-SUBSET-SUM. Each counter is produced by the same recursion as its returned value.
noncomputable sectionnamespace CLRSnamespace ApproxSubsetSumResult and unit-operation count of a list-producing scan.
structure ListExecution where
value : List Nat
work : Nat
deriving ReprResult and unit-operation count of a natural-number-producing scan.
structure NatExecution where
value : Nat
work : Nat
deriving Repr
Add x to every element, charging one addition per element.
def mapAddWithCost (x : Nat) : List Nat → ListExecution
| [] => ⟨[], 0⟩
| y :: ys =>
let rest := mapAddWithCost x ys
⟨(y + x) :: rest.value, rest.work + 1⟩CLRS MERGE-LISTS, charging one comparison whenever both inputs are nonempty.
def mergeWithCost : (L M : List Nat) → ListExecution
| [], ys => ⟨ys, 0⟩
| xs, [] => ⟨xs, 0⟩
| x :: xs, y :: ys =>
if x ≤ y then
let rest := mergeWithCost xs (y :: ys)
⟨x :: rest.value, rest.work + 1⟩
else
let rest := mergeWithCost (x :: xs) ys
⟨y :: rest.value, rest.work + 1⟩
termination_by L M => L.length + M.lengthTail scan of TRIM, charging one threshold comparison per scanned value.
def trimAuxWithCost (δ : Real) : Nat → List Nat → ListExecution
| _last, [] => ⟨[], 0⟩
| last, y :: ys =>
if (1 + δ) * (last : Real) < (y : Real) then
let rest := trimAuxWithCost δ y ys
⟨y :: rest.value, rest.work + 1⟩
else
let rest := trimAuxWithCost δ last ys
⟨rest.value, rest.work + 1⟩CLRS TRIM with a counter for its tail comparisons.
def trimWithCost (δ : Real) : List Nat → ListExecution
| [] => ⟨[], 0⟩
| y :: ys =>
let rest := trimAuxWithCost δ y ys
⟨y :: rest.value, rest.work⟩
Keep values at most t, charging one target comparison per value.
def filterAtMostWithCost (t : Nat) : List Nat → ListExecution
| [] => ⟨[], 0⟩
| y :: ys =>
let rest := filterAtMostWithCost t ys
if y ≤ t then
⟨y :: rest.value, rest.work + 1⟩
else
⟨rest.value, rest.work + 1⟩Maximum scan with an explicit accumulator and one comparison per value.
def maximumAuxWithCost (best : Nat) : List Nat → NatExecution
| [] => ⟨best, 0⟩
| y :: ys =>
let rest := maximumAuxWithCost (max best y) ys
⟨rest.value, rest.work + 1⟩
Maximum of a natural-number list, using 0 for the empty case.
def maximumWithCost (xs : List Nat) : NatExecution :=
maximumAuxWithCost 0 xsend ApproxSubsetSumend CLRSCLRSLean.FourthEdition.Chapter_35.Section_35_5_The_Subset_Sum_Problem.Costed.Execution
CLRS Section 35.5 - Costed APPROX-SUBSET-SUM execution
The outer recursion composes the costed map, merge, trim, and filter scans. The final wrapper scans the resulting list for its maximum.
noncomputable sectionnamespace CLRSnamespace ApproxSubsetSumCosted construction of the trimmed lists. The stored work is exactly the sum of the recursively executed local scan counters plus one outer-loop unit.
def approxListsWithCost (δ : Real) (t : Nat) : List Nat → ListExecution
| [] => ⟨[0], 0⟩
| x :: xs =>
let prior := approxListsWithCost δ t xs
let shifted := mapAddWithCost x prior.value
let merged := mergeWithCost prior.value shifted.value
let trimmed := trimWithCost δ merged.value
let kept := filterAtMostWithCost t trimmed.value
⟨kept.value,
prior.work + shifted.work + merged.work + trimmed.work + kept.work + 1⟩Erasing the outer counter gives the existing semantic trimmed-list construction.
theorem approxListsWithCost_value (δ : Real) (t : Nat) (xs : List Nat) :
(approxListsWithCost δ t xs).value = approxLists δ t xs := by
induction xs with
| nil => simp [approxListsWithCost, approxLists]
| cons x xs ih =>
simp [approxListsWithCost, approxLists, ih, mapAddWithCost_value,
mergeWithCost_value, trimWithCost_value, filterAtMostWithCost_value]
A fold by max never drops its initial accumulator.
theorem le_foldl_max (best : Nat) (L : List Nat) :
best ≤ L.foldl max best := by
induction L generalizing best with
| nil => simp
| cons y ys ih =>
exact (Nat.le_max_left best y).trans (ih (max best y))
Every list member is bounded by a fold by max.
theorem mem_le_foldl_max (best : Nat) {L : List Nat} {x : Nat}
(hx : x ∈ L) : x ≤ L.foldl max best := by
induction L generalizing best with
| nil => simp at hx
| cons y ys ih =>
simp only [List.mem_cons] at hx
simp only [List.foldl_cons]
rcases hx with hxy | hx
· subst x
exact (Nat.le_max_right best y).trans (le_foldl_max (max best y) ys)
· exact ih (max best y) hx
A fold by max is below every common upper bound for its accumulator
and list elements.
theorem foldl_max_le (L : List Nat) (best bound : Nat)
(hbest : best ≤ bound) (hmem : ∀ x ∈ L, x ≤ bound) :
L.foldl max best ≤ bound := by
induction L generalizing best with
| nil => simpa using hbest
| cons y ys ih =>
simp only [List.foldl_cons]
apply ih (max best y)
· exact max_le hbest (hmem y (by simp))
· intro x hx
exact hmem x (by simp [hx])
On a list containing 0, the maximum scan agrees with the nonempty
Finset maximum used by approxSum.
theorem foldl_max_eq_toFinset_max' {L : List Nat} (h0 : 0 ∈ L) :
L.foldl max 0 = L.toFinset.max' ⟨0, by simpa using h0⟩ := by
apply le_antisymm
· apply foldl_max_le
· exact L.toFinset.le_max' 0 (by simpa using h0)
· intro x hx
exact L.toFinset.le_max' x (by simpa using hx)
· have hmax : L.toFinset.max' ⟨0, by simpa using h0⟩ ∈ L := by
simpa using L.toFinset.max'_mem ⟨0, by simpa using h0⟩
exact mem_le_foldl_max 0 hmaxCosted APPROX-SUBSET-SUM, including the final maximum scan.
def approxSubsetSumWithCost (xs : List Nat) (t : Nat) (ε : Real) : NatExecution :=
let lists := approxListsWithCost (ε / (2 * (xs.length : Real))) t xs
let answer := maximumWithCost lists.value
⟨answer.value, lists.work + answer.work⟩
Erasing the complete execution counter gives the existing
approxSum result.
theorem approxSubsetSumWithCost_value (xs : List Nat) (t : Nat) (ε : Real) :
(approxSubsetSumWithCost xs t ε).value = approxSum xs t ε := by
rw [approxSubsetSumWithCost]
simp only
rw [maximumWithCost_value, approxListsWithCost_value]
unfold approxSum
apply foldl_max_eq_toFinset_max'
exact zero_mem_approxLists _ _ _end ApproxSubsetSumend CLRSCLRSLean.FourthEdition.Chapter_35.Section_35_5_The_Subset_Sum_Problem.Costed.LocalCorrectness
CLRS Section 35.5 - Local scan correctness and work
Erasure and linear counter bounds for the concrete list scans used by the costed APPROX-SUBSET-SUM execution.
noncomputable sectionnamespace CLRSnamespace ApproxSubsetSumtheorem mapAddWithCost_value (x : Nat) (L : List Nat) :
(mapAddWithCost x L).value = L.map (fun y => y + x) := by
induction L with
| nil => simp [mapAddWithCost]
| cons y ys ih => simp [mapAddWithCost, ih]theorem mapAddWithCost_work (x : Nat) (L : List Nat) :
(mapAddWithCost x L).work = L.length := by
induction L with
| nil => simp [mapAddWithCost]
| cons y ys ih => simp [mapAddWithCost, ih]theorem mergeWithCost_value (L M : List Nat) :
(mergeWithCost L M).value = merge L M := by
induction L generalizing M with
| nil => simp [mergeWithCost, merge]
| cons x xs ihL =>
induction M with
| nil => simp [mergeWithCost, merge]
| cons y ys ihM =>
by_cases hxy : x ≤ y
· simp [mergeWithCost, merge, hxy, ihL]
· simp [mergeWithCost, merge, hxy, ihM]
theorem mergeWithCost_length (L M : List Nat) :
(mergeWithCost L M).value.length = L.length + M.length := by
induction L generalizing M with
| nil => simp [mergeWithCost]
| cons x xs ihL =>
induction M with
| nil => simp [mergeWithCost]
| cons y ys ihM =>
by_cases hxy : x ≤ y
· simp only [mergeWithCost, hxy, ↓reduceIte, List.length_cons]
rw [ihL]
simp only [List.length_cons]
omega
· simp only [mergeWithCost, hxy, ↓reduceIte, List.length_cons]
rw [ihM]
simp only [List.length_cons]
omegatheorem mergeWithCost_work_le (L M : List Nat) :
(mergeWithCost L M).work ≤ L.length + M.length := by
induction L generalizing M with
| nil => simp [mergeWithCost]
| cons x xs ihL =>
induction M with
| nil => simp [mergeWithCost]
| cons y ys ihM =>
by_cases hxy : x ≤ y
· simp only [mergeWithCost, hxy, ↓reduceIte, List.length_cons]
have h := ihL (y :: ys)
simp only [List.length_cons] at h
omega
· simp only [mergeWithCost, hxy, ↓reduceIte, List.length_cons]
have h := ihM
simp only [List.length_cons] at h
omegatheorem trimAuxWithCost_value (δ : Real) (last : Nat) (ys : List Nat) :
(trimAuxWithCost δ last ys).value = trimAux δ last ys := by
induction ys generalizing last with
| nil => simp [trimAuxWithCost, trimAux]
| cons y ys ih =>
by_cases hkeep : (1 + δ) * (last : Real) < (y : Real)
· simp [trimAuxWithCost, trimAux, hkeep, ih]
· simp [trimAuxWithCost, trimAux, hkeep, ih]theorem trimAuxWithCost_work (δ : Real) (last : Nat) (ys : List Nat) :
(trimAuxWithCost δ last ys).work = ys.length := by
induction ys generalizing last with
| nil => simp [trimAuxWithCost]
| cons y ys ih =>
by_cases hkeep : (1 + δ) * (last : Real) < (y : Real)
· simp [trimAuxWithCost, hkeep, ih]
· simp [trimAuxWithCost, hkeep, ih]theorem trimWithCost_value (δ : Real) (L : List Nat) :
(trimWithCost δ L).value = trim δ L := by
cases L with
| nil => simp [trimWithCost, trim]
| cons y ys => simp [trimWithCost, trim, trimAuxWithCost_value]theorem trimWithCost_work_le (δ : Real) (L : List Nat) :
(trimWithCost δ L).work ≤ L.length := by
cases L with
| nil => simp [trimWithCost]
| cons y ys => simp [trimWithCost, trimAuxWithCost_work]
theorem trimWithCost_length_le (δ : Real) (L : List Nat) :
(trimWithCost δ L).value.length ≤ L.length := by
rw [trimWithCost_value]
exact (trim_sublist δ L).length_letheorem filterAtMostWithCost_value (t : Nat) (L : List Nat) :
(filterAtMostWithCost t L).value = L.filter (fun y => y ≤ t) := by
induction L with
| nil => simp [filterAtMostWithCost]
| cons y ys ih =>
by_cases hy : y ≤ t
· simp [filterAtMostWithCost, hy, ih]
· simp [filterAtMostWithCost, hy, ih]theorem filterAtMostWithCost_work (t : Nat) (L : List Nat) :
(filterAtMostWithCost t L).work = L.length := by
induction L with
| nil => simp [filterAtMostWithCost]
| cons y ys ih =>
by_cases hy : y ≤ t
· simp [filterAtMostWithCost, hy, ih]
· simp [filterAtMostWithCost, hy, ih]
theorem filterAtMostWithCost_length_le (t : Nat) (L : List Nat) :
(filterAtMostWithCost t L).value.length ≤ L.length := by
rw [filterAtMostWithCost_value]
exact List.length_filter_le (fun y => y ≤ t) Ltheorem maximumAuxWithCost_value (best : Nat) (L : List Nat) :
(maximumAuxWithCost best L).value = L.foldl max best := by
induction L generalizing best with
| nil => simp [maximumAuxWithCost]
| cons y ys ih => simp [maximumAuxWithCost, ih]theorem maximumAuxWithCost_work (best : Nat) (L : List Nat) :
(maximumAuxWithCost best L).work = L.length := by
induction L generalizing best with
| nil => simp [maximumAuxWithCost]
| cons y ys ih => simp [maximumAuxWithCost, ih]theorem maximumWithCost_value (L : List Nat) :
(maximumWithCost L).value = L.foldl max 0 := by
exact maximumAuxWithCost_value 0 Ltheorem maximumWithCost_work (L : List Nat) :
(maximumWithCost L).work = L.length := by
exact maximumAuxWithCost_work 0 Lend ApproxSubsetSumend CLRSScope and implementation notes
Imports
import CLRSLean.FourthEdition.Chapter_35.Section_35_1_The_Vertex_Cover_Problem
import CLRSLean.FourthEdition.Chapter_35.Section_35_2_The_Traveling_Salesperson_Problem
import CLRSLean.FourthEdition.Chapter_35.Section_35_3_The_Set_Covering_Problem
import CLRSLean.FourthEdition.Chapter_35.Section_35_4_Randomization_And_Linear_Programming
import CLRSLean.FourthEdition.Chapter_35.Section_35_5_The_Subset_Sum_Problem
import CLRSLean.FourthEdition.Chapter_35.Section_35_5_The_Subset_Sum_Problem.Costed
import CLRSLean.FourthEdition.Chapter_35.Section_35_2_The_Traveling_Salesperson_Problem.GraphExecution
import CLRSLean.FourthEdition.Chapter_35.Section_35_3_The_Set_Covering_Problem.ReturnedFamily
import CLRSLean.FourthEdition.Chapter_35.Section_35_4_Randomization_And_Linear_Programming.VertexCoverLPCurrent source
No legacy source is promoted into this chapter.
Coverage boundary
Status: main-proof-complete.
Section 35.1 (the vertex-cover problem) is a native fourth-edition section: it formalizes the vertex-cover problem, the greedy APPROX-VERTEX-COVER algorithm, and its 2-approximation guarantee (Lemma 35.1 and Theorem 35.1). It is imported through Section 35.1.
Section 35.2 (the traveling-salesperson problem) is also a native fourth-edition
section: its original model takes a rooted minimum spanning tree and
proves that the depth-first walk costs exactly twice the tree (Lemma 35.2), that
the preorder tour visits every vertex exactly once, that shortcutting the walk
costs no more than the walk (triangle inequality), and — combining these with
Lemma 35.3 (an MST costs no more than any tour) — that APPROX-TSP-TOUR returns a
tour within a factor of two of any tour (Theorem 35.2). The new
GraphAdapter.graphTour starts from a complete Nat-weighted graph on
Fin n and a root, runs the Chapter 21 Prim frontier construction, and
roots its selected edges. Its factor-two theorem constructs the minimum-tree
obligations internally and needs only the stated metric assumptions and a
comparator tour. Rooting and component decisions are classical finite
constructions; no implementation runtime is asserted here. It is imported through
Section 35.2.
Section 35.3 (the set-covering problem) is a native fourth-edition section: it
models the universe and family of GREEDY-SET-COVER, the greedy pick, the
returned family, and — via the harmonic charging argument — proves that the
number of sets picked is at most H(d) times the size of any cover, where d
bounds the set sizes (Theorem 35.3), and — via the iterated multiplicative
shrink of the uncovered set — that GREEDY-SET-COVER is an O(lg |X|)-
approximation algorithm (Theorem 35.4).
greedySetCover_card_eq_cost connects the actual returned family to this
pick count; greedySetCover_card_approx and
greedySetCover_card_ln_approx bound that returned cardinality. It is imported through
Section 35.3.
Section 35.4 (randomization and linear programming) is a native fourth-edition
section: it proves the randomized 8/7-approximation of MAX-3-CNF (Theorem
35.5), where a clause with three literals over distinct variables is satisfied
with probability 7/8 under a uniformly random assignment and linearity of
expectation gives the 7/8 · |F| bound, and the factor-two LP-rounding
approximation of minimum-weight vertex cover (Theorem 35.6), where rounding the
fractional cover x up at the 1/2 threshold costs at most twice the LP
objective. The random model uses an unweighted finite set of clauses; duplicate
clauses collapse, and each clause must use three distinct variables.
VertexCoverLP.execute constructs the edge and box constraints, invokes
initialized Chapter 29 SIMPLEX, and rounds its returned optimum. Feasibility
and nonnegative rational weights rule out the solver’s infeasible and unbounded
outcomes; every integral comparator cover supplies the lower-bound bridge.
VertexCoverLP.execute_correct proves coverage and factor two without a
supplied fractional solution or objective-bound premise. This Fin-indexed
construction uses real fractional vectors and exact-real classical SIMPLEX;
it makes no polynomial SIMPLEX or bit-runtime claim. It is imported through
Section 35.4.
Section 35.5 (the subset-sum problem) is a native fourth-edition section: it
models the subset-sum problem and EXACT-SUBSET-SUM through the set subsetSums
of achievable sums and the optimum optimalSum, the greedy trim of a sorted
list (Lemma 35.5, TRIM), and the trimmed lists of APPROX-SUBSET-SUM. Theorem
35.7 proves the (1 + ε)-approximation: the value z* returned by
APPROX-SUBSET-SUM is an achievable subset sum at most t and the optimum y*
satisfies y* ≤ (1 + ε) · z* (via the compounded (1 + ε/(2n))^n ≤ e^{ε/2} ≤
1 + ε bound). Theorem 35.8 (the FPTAS running-time analysis) shows that, with
δ = ε/(2n) and n = |S|, the intermediate list-size theorem
approxSubsetSum_fptas supplies the semantic bound used by the executable
analysis. The costed refinement performs the actual map-add, merge, trim,
target-filter, and final-maximum scans and records their work. Its erasure
theorem approxSubsetSumWithCost_value identifies the returned value with
approxSum; approxSubsetSumWithCost_fptas proves for that same run both the
Theorem 35.7 approximation guarantee and the explicit work bound
48 · (n + 1)² · (log t + 1) / ε.
This is a unit-cost list model: one unit is charged for each modeled addition, comparison, or outer composition step. Bit complexity, allocation, and an imperative-array refinement remain outside this theorem's stated boundary. The development is imported through Section 35.5.
See docs/clrs-fourth-edition-map.csv for the section-level mapping and
docs/migrations/clrs4.md for compatibility and deprecation policy.
The book continues with you
Keep asking. Keep proving.
Every theorem begins with a question. Explore a proof, examine its assumptions, or help make the next chapter clearer.
A project by TankTechnology and contributors. Built with Lean, Mathlib and Verso. With thanks to the authors of Introduction to Algorithms and the formalization community.
This independent companion covers a selected proof inventory. Read the scope and verification notes.
CLRS, fourth edition · Chapter 35 of 35