From 176124342839311f20584fc4f05932433282e1af Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 18:02:17 +0000 Subject: [PATCH 1/9] Import complete chip-firing-with-lean proof development --- LeanPool.lean | 1 + LeanPool/ChipFiring.lean | 27 + LeanPool/ChipFiring/ChipFiringWithLean.lean | 15 + .../ChipFiringWithLean/Algorithms.lean | 277 +++ .../ChipFiring/ChipFiringWithLean/Basic.lean | 1748 +++++++++++++++++ .../ChipFiringWithLean/CFGraphExample.lean | 170 ++ .../ChipFiring/ChipFiringWithLean/Config.lean | 773 ++++++++ .../ChipFiringWithLean/Orientation.lean | 1259 ++++++++++++ .../ChipFiringWithLean/PalomarSolution.lean | 39 + .../ChipFiringWithLean/RRGHelpers.lean | 544 +++++ .../ChipFiring/ChipFiringWithLean/Rank.lean | 352 ++++ .../ChipFiringWithLean/RiemannRoch.lean | 384 ++++ LeanPool/projects.yml | 36 + 13 files changed, 5625 insertions(+) create mode 100644 LeanPool/ChipFiring.lean create mode 100644 LeanPool/ChipFiring/ChipFiringWithLean.lean create mode 100644 LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean create mode 100644 LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean create mode 100644 LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean create mode 100644 LeanPool/ChipFiring/ChipFiringWithLean/Config.lean create mode 100644 LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean create mode 100644 LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean create mode 100644 LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean create mode 100644 LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean create mode 100644 LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean diff --git a/LeanPool.lean b/LeanPool.lean index 50fa6e5b30..64e12372ce 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -443,6 +443,7 @@ import LeanPool.ChannelCapacity.Finite import LeanPool.ChannelCapacity.KernelCompositionKullbackLeibler import LeanPool.ChannelCapacity.NonDegeneracy import LeanPool.ChannelCapacity.StrictConcavity +import LeanPool.ChipFiring import LeanPool.Chudnovsky import LeanPool.Chudnovsky.Basic import LeanPool.Chudnovsky.Chudnovsky diff --git a/LeanPool/ChipFiring.lean b/LeanPool/ChipFiring.lean new file mode 100644 index 0000000000..8e76c1346d --- /dev/null +++ b/LeanPool/ChipFiring.lean @@ -0,0 +1,27 @@ +/- +Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger +-/ + +import LeanPool.ChipFiring.ChipFiringWithLean +import LeanPool.ChipFiring.ChipFiringWithLean.Algorithms +import LeanPool.ChipFiring.ChipFiringWithLean.Basic +import LeanPool.ChipFiring.ChipFiringWithLean.CFGraphExample +import LeanPool.ChipFiring.ChipFiringWithLean.Config +import LeanPool.ChipFiring.ChipFiringWithLean.Orientation +import LeanPool.ChipFiring.ChipFiringWithLean.PalomarSolution +import LeanPool.ChipFiring.ChipFiringWithLean.RRGHelpers +import LeanPool.ChipFiring.ChipFiringWithLean.Rank +import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch + +/-! +# Chip-Firing with Lean 4 + +Source: url:https://github.com/dhyeymavani2003/chip-firing-with-lean +Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger +Status: verified +Main declarations: `Propositions.riemann_roch`, `Propositions.clifford` +Tags: combinatorics +MSC: 05C57, 14T20 +-/ diff --git a/LeanPool/ChipFiring/ChipFiringWithLean.lean b/LeanPool/ChipFiring/ChipFiringWithLean.lean new file mode 100644 index 0000000000..547136826b --- /dev/null +++ b/LeanPool/ChipFiring/ChipFiringWithLean.lean @@ -0,0 +1,15 @@ +/- +Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger +-/ +-- This module serves as the root of the `ChipFiringWithLean` library. +-- Import modules here that should be built as part of the library. +import LeanPool.ChipFiring.ChipFiringWithLean.Basic +import LeanPool.ChipFiring.ChipFiringWithLean.CFGraphExample +import LeanPool.ChipFiring.ChipFiringWithLean.Config +import LeanPool.ChipFiring.ChipFiringWithLean.Orientation +import LeanPool.ChipFiring.ChipFiringWithLean.Algorithms +import LeanPool.ChipFiring.ChipFiringWithLean.Rank +import LeanPool.ChipFiring.ChipFiringWithLean.RRGHelpers +import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean new file mode 100644 index 0000000000..b04c678a0a --- /dev/null +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean @@ -0,0 +1,277 @@ +/- +Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger +-/ +import LeanPool.ChipFiring.ChipFiringWithLean.Orientation + + +namespace CF + +/-! +## Experimental computational algorithms for chip-firing + +This file contains an early executable implementation of several chip-firing algorithms, +including greedy dollar-game play, Dhar's burning algorithm, and $q$-reduction routines. + +The formal proof of Riemann-Roch in this repository does not rely on this file. Some of +these definitions predate the current theorem-proving infrastructure and should be treated +as exploratory code rather than certified implementations of the textbook algorithms. +In particular, the core mathematical statements about $q$-reduced divisors, superstability, +and Dhar's algorithm are proved elsewhere in the library. +-/ + +open Finset BigOperators List + +/-- Checks whether a divisor is effective, meaning that all vertex values are nonnegative. -/ +@[simp] +def is_effective (D : CFDiv G) : Bool := decide (∀ v, D v ≥ 0) + +/-- A small size measure used only to set conservative default loop fuel. -/ +private def divisorMagnitude (G : CFGraph) (D : CFDiv G) : Nat := + ∑ v : G.V, Int.natAbs (D v) + +/-- Default fuel for greedy routines, scaled by the actual chip counts in the input. -/ +private def greedyFuel (G : CFGraph) (D : CFDiv G) : Nat := + (Fintype.card G.V + 1) * (divisorMagnitude G D + 1) ^ 2 + 1 + +/-- Number of chips away from the source, used for the q-reduction loop budget. -/ +private def nonSourceChipCount (G : CFGraph) (q : G.V) (D : CFDiv G) : Nat := + ∑ v ∈ Finset.univ.erase q, Int.toNat (D v) + +/-- +The greedy algorithm for the dollar game (Corry-Perkinson, Algorithm 1). + +The algorithm repeatedly chooses an in-debt vertex $v$, performs a borrowing move +at $v$, and records in $M$ that $v$ has borrowed at least once. Vertices already +in $M$ may still need to borrow again. +Returns `(winnable, script)` where `winnable` is true if an effective divisor is reached, +and `script` is the net borrowing count for each vertex if winnable. +-/ +@[simp] +noncomputable def greedyWinnable (G : CFGraph) (D : CFDiv G) : Bool × Option (CFDiv G) := + let rec loop (current_D : CFDiv G) (M : Finset G.V) (script : CFDiv G) (fuel : Nat) : Bool × Option (CFDiv G) := + if _h_fuel_zero : fuel = 0 then (false, none) -- Fuel exhaustion implies failure + else if is_effective current_D then (true, some script) + else if M = Finset.univ then (false, none) -- All vertices borrowed, still not effective + else + -- Find any in-debt vertex. The marked set only records which vertices have + -- borrowed at least once; it does not prevent a vertex from borrowing again. + match Finset.univ.toList.find? (fun v => current_D v < 0) with + | some v => + let next_D := borrowing_move G current_D v + let next_M := insert v M + -- Update script: decrement count for borrowing vertex v + let next_script : CFDiv G := script - one_chip v + loop next_D next_M next_script (fuel - 1) + | none => -- No vertex is in debt, but `D` is not effective. + -- This state implies unwinnability because we can't make progress. + (false, none) + termination_by fuel + decreasing_by simp_wf; exact Nat.pos_of_ne_zero _h_fuel_zero -- Simpler explicit proof + -- Initial call with generous fuel + let max_fuel := greedyFuel G D + loop D ∅ (0 : CFDiv G) max_fuel -- Initialize script as (0 : CFDiv G) + +/-- Finds a burnable vertex $v \in S$, meaning one satisfying +$c(v) < \operatorname{outdeg}_S(v)$. + +Returns `some v` if found, `none` otherwise. -/ +noncomputable def findBurnableVertex (G : CFGraph) (c : G.V → ℤ) (S : Finset G.V) : Option { v : G.V // v ∈ S } := + -- Iterate through the list representation and find the first match + -- Need to get proof v ∈ S, which is guaranteed by iterating S.toList + let p := fun v => decide (c v < outdeg_S G S v) -- Use decide + match h : S.toList.find? p with -- Use find? directly now (List is open) + | some v => + -- Prove v is in the original finset S + have h_mem_list : v ∈ S.toList := List.mem_of_find?_eq_some h + have h_mem_finset : v ∈ S := Finset.mem_toList.mp h_mem_list + some ⟨v, h_mem_finset⟩ + | none => none + +/-- +The core iterative burning process of Dhar's algorithm (Corry-Perkinson, Algorithm 2). + +Given a configuration $c$ (represented here as a function $V(G) \to \mathbb{Z}$, +with nonnegativity away from $q$ handled externally) and a sink $q$, this returns the +set of unburnt vertices $S \subseteq V(G) \setminus \{q\}$. The set $S$ is empty if +and only if the restriction of $c$ to $V(G) \setminus \{q\}$ is superstable relative to $q$. + +The implementation uses well-founded recursion on the size of $S$. +-/ +@[simp] +noncomputable def dharBurningSet (G : CFGraph) (q : G.V) (c : G.V → ℤ) : Finset G.V := + let initial_S := Finset.univ.erase q + let rec loop (S : Finset G.V) (fuel : Nat) : Finset G.V := + -- Check fuel for termination safety + if _h_fuel_zero : fuel = 0 then S -- Name hypothesis + else + match findBurnableVertex G c S with + -- If a burnable vertex v is found, remove it and recurse + | some ⟨v, hv⟩ => loop (S.erase v) (fuel - 1) + -- If no burnable vertex found in S, S is stable, return it + | none => S + termination_by fuel + decreasing_by simp_wf; exact Nat.pos_of_ne_zero _h_fuel_zero -- Simpler explicit proof + loop initial_S (Fintype.card G.V + 1) + +/-- Fires every vertex in $S$, starting from the divisor $D$. -/ +@[simp] +noncomputable def fireSet (G : CFGraph) (D : CFDiv G) (S : Finset G.V) : CFDiv G := + -- Use foldl directly now (List is open) + foldl (fun current_D v => firing_move G current_D v) D S.toList + +/-- +The preprocessing step for `findQReducedDivisor`. + +This borrows greedily at in-debt non-source vertices until $D(v) \ge 0$ for all +$v \ne q$ (Corry-Perkinson, Algorithm 4). +Requires sufficient fuel for the termination guard. +Returns `none` if fuel runs out, implying potential unwinnability or insufficient fuel. +-/ +noncomputable def makeNonNegativeExceptQ (G : CFGraph) (q : G.V) (D : CFDiv G) (max_fuel : Nat) : Option (CFDiv G) := + let rec loop (current_D : CFDiv G) (fuel : Nat) : Option (CFDiv G) := + if _h_fuel_zero : fuel = 0 then none -- Name hypothesis + else + -- Check if any vertex v != q has D(v) < 0 + let non_q_vertices := Finset.univ.erase q + -- Use `find?` to efficiently check for a negative vertex + match non_q_vertices.toList.find? (fun v => current_D v < 0) with + | none => some current_D -- Goal reached: all v != q are non-negative + | some v => -- Found a vertex v != q with current_D v < 0 + -- Borrow at the in-debt non-source vertex and continue. + loop (borrowing_move G current_D v) (fuel - 1) + termination_by fuel + decreasing_by simp_wf; exact Nat.pos_of_ne_zero _h_fuel_zero -- Simpler explicit proof + loop D max_fuel + +/-- +Finds the unique $q$-reduced divisor linearly equivalent to $D$ (Corry-Perkinson, +Algorithm 3). + +Starting from $D$, the algorithm first preprocesses by borrowing greedily at +in-debt non-source vertices until all vertices other than $q$ are nonnegative. +It then repeatedly finds the maximal legal firing set +$S \subseteq V(G) \setminus \{q\}$ using `dharBurningSet`, and fires $S$ until +`dharBurningSet` returns the empty set. + +Returns `none` if preprocessing fails (fuel exhaustion or insufficient degree). +-/ +@[simp] +noncomputable def findQReducedDivisor (G : CFGraph) (q : G.V) (D : CFDiv G) : Option (CFDiv G) := + -- Preprocessing: borrow at in-debt non-source vertices until D(v) >= 0 for v != q. + -- Use chip-size-aware fuel rather than a graph-size-only bound. + let preprocess_fuel : Nat := greedyFuel G D + match makeNonNegativeExceptQ G q D preprocess_fuel with + | none => none -- Preprocessing failed + | some D_preprocessed => + let rec loop (current_D : CFDiv G) (fuel : Nat) : CFDiv G := + if h_fuel_zero : fuel = 0 then -- Name hypothesis + -- Fuel exhausted in main loop, return current state (might not be fully q-reduced) + current_D + else + -- Use current_D as the configuration function for dharBurningSet + let S := dharBurningSet G q current_D + -- If the set S is non-empty, fire it and continue looping + if hs : S.Nonempty then + loop (fireSet G current_D S) (fuel - 1) + else + -- S is empty, the divisor is q-reduced + current_D + termination_by fuel + decreasing_by simp_wf; exact Nat.pos_of_ne_zero h_fuel_zero -- Simpler explicit proof + -- Estimate fuel for main loop from possible q-effective non-source chip vectors. + let main_loop_fuel := (nonSourceChipCount G q D_preprocessed + 1) ^ Fintype.card G.V + 1 + some (loop D_preprocessed main_loop_fuel) + +/-- Simulates the fire spread from $q$ in Dhar's algorithm on a configuration $c$. + +Returns the set of unburnt vertices $S \subseteq V(G) \setminus \{q\}$. +Equivalent to `dharBurningSet`. -/ +@[simp] +noncomputable def burn (G : CFGraph) (q : G.V) (c : G.V → ℤ) : Finset G.V := + dharBurningSet G q c + +/-- Finds the $v$-reduced divisor linearly equivalent to $D$. + +This wraps `findQReducedDivisor`. +Returns `none` if the reduction process fails. -/ +@[simp] +noncomputable def dhar (G : CFGraph) (D : CFDiv G) (v : G.V) : Option (CFDiv G) := + findQReducedDivisor G v D + +/-- +The efficient winnability determination algorithm. + +This checks whether $D$ is winnable by finding the $q$-reduced representative $D_q$ +and checking whether $D_q(q) \ge 0$ (see Corry-Perkinson, Corollary 3.7). It requires +a chosen source vertex $q$ and returns `false` if the reduction process fails. +-/ +@[simp] +noncomputable def isWinnable (G : CFGraph) (q : G.V) (D : CFDiv G) : Bool := + match findQReducedDivisor G q D with + | none => false -- Reduction process failed (preprocessing or main loop fuel) + | some D_q => D_q q >= 0 + +/-- +Calculates the incoming burning degree of a vertex $v$ from a set $B$. + +This sums `num_edges` from each $u \in B$ to $v$. +-/ +def burning_indeg (G : CFGraph) (B : Finset G.V) (v : G.V) : ℤ := + ∑ u ∈ B, (num_edges G u v : ℤ) + +/-- +The orientation-based version of Dhar's algorithm (Corry-Perkinson, Algorithm 5). + +This takes a nonnegative configuration $c$ relative to $q$, and returns the final stable set +$S \subseteq V(G) \setminus \{q\}$ (empty if and only if $c$ is superstable) together +with a multiset $O$ of directed edges $(u,v)$ where fire spread from $u$ to $v$. + +Note: this assumes $c$ is nonnegative on $V(G) \setminus \{q\}$. +The returned multiset `O` represents the edges oriented *by* the burning process. +It may not form a complete `CFOrientation` structure directly if not all edges are involved. +-/ +@[simp] +noncomputable def dharBurningSetWithOrientation (G : CFGraph) (q : G.V) (c : G.V → ℤ) + : Finset G.V × Multiset (G.V × G.V) := + let initial_S := Finset.univ.erase q + let initial_B := {q} + let initial_O := (∅ : Multiset (G.V × G.V)) + + let rec loop (current_S : Finset G.V) (current_B : Finset G.V) (current_O : Multiset (G.V × G.V)) (fuel : Nat) + : Finset G.V × Multiset (G.V × G.V) := + if h_fuel : fuel = 0 then (current_S, current_O) -- Fuel exhausted, return current state + else + -- Find vertices in S that burn in this step + let newly_burned_list := current_S.toList.filter (fun v => burning_indeg G current_B v > c v) + let newly_burned := newly_burned_list.toFinset -- Use List.toFinset + + -- If no new vertices burned, the process stabilizes + if newly_burned.card = 0 then (current_S, current_O) -- Use card = 0 check + else + -- Update S and B + let next_S := current_S.filter (fun v => v ∉ newly_burned) -- Manual set difference + let next_B := current_B ∪ newly_burned + + -- Update Orientation: Add edges from current_B to newly_burned + -- Use Finset.sum for clarity and potentially better type inference + let edges_to_add : Multiset (G.V × G.V) := + Finset.sum newly_burned (fun v_new => -- Sum over newly burned vertices + Finset.sum current_B (fun u => -- For each u in the burning set + Multiset.replicate (num_edges G u v_new) (u, v_new) -- Create edges u -> v_new + ) + ) + + let next_O := current_O + edges_to_add + + -- Recurse + loop next_S next_B next_O (fuel - 1) + + termination_by fuel + decreasing_by simp_wf; exact Nat.pos_of_ne_zero h_fuel -- Use robust termination proof + + -- Initial call with fuel based on number of vertices + loop initial_S initial_B initial_O (Fintype.card G.V + 1) + +end CF diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean new file mode 100644 index 0000000000..e610706568 --- /dev/null +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean @@ -0,0 +1,1748 @@ +/- +Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger +-/ +import Mathlib.Algebra.CharP.Defs +import Mathlib.Algebra.Group.Subgroup.Finite +import Mathlib.Analysis.Normed.Ring.Lemmas +import Mathlib.Data.Matrix.Mul + + + +universe u + +open Multiset Finset + +/-! +## Chip-firing graphs + +A *chip-firing graph* (`CFGraph`) is a loopless undirected multigraph with bundled vertex type +$V(G)$, implemented as `G.V` and assumed to be finite, decidably equal, and nonempty. +Edges are stored as a multiset of ordered pairs; `num_edges G v w` counts the total edge +multiplicity between $v$ and $w$, including both $(v,w)$ and $(w,v)$ entries. + +We define the *degree* (valence) of a vertex as the sum of edge multiplicities at that vertex, +and the *genus* (cyclomatic number) $g = |E| - |V(G)| + 1$, which plays a central role in the +Riemann-Roch theorem for graphs. + +Many main theorems in this library require connectivity; see `graph_connected`. In those cases, a +proof of connectivity must be provided as an additional argument. +-/ + +/-- A *chip-firing graph* is a loopless multigraph. +It is not assumed connected by default, though many of our main theorems pertain to +connected graphs. -/ +structure CFGraph where + V : Type u + [instDecidableEq : DecidableEq V] + [instFintype : Fintype V] + [instNonempty : Nonempty V] + (edges : Multiset (V × V)) + (loopless : ∀ v, (v, v) ∉ edges) + +attribute [instance] CFGraph.instDecidableEq CFGraph.instFintype CFGraph.instNonempty + +/-- The edge multiplicity between vertices $v$ and $w$. + +When working with chip-firing graphs in this repository, prefer this function to the +underlying multiset of edges. -/ +def num_edges (G : CFGraph) (v w : G.V) : ℕ := + Multiset.card (G.edges.filter (λ e => e = (v, w) ∨ e = (w, v))) + +/-- A graph is *connected* if its vertices cannot be partitioned into two nonempty sets +with no edges between them. + +This is equivalent to saying that there is a path between any two vertices, but the +partition formulation is more convenient in this repository. -/ +def graph_connected (G : CFGraph) : Prop := + ∀ S : Finset G.V, (∃ (v w : G.V), v ∈ S ∧ w ∉ S) → + (∃ v ∈ S, ∃ w ∉ S, num_edges G v w > 0) + +/-- The genus of a graph is its cyclomatic number, $|E| - |V| + 1$. -/ +def genus (G : CFGraph) : ℤ := + Multiset.card G.edges - Fintype.card G.V + 1 + +/-- The number of edges between two vertices is symmetric (the graph is undirected). -/ +lemma num_edges_symmetric (G : CFGraph) (v w : G.V) : + num_edges G v w = num_edges G w v := by + simp only [num_edges, Or.comm] + +/-- Numerical version of *loopless*: the number of edges from a vertex to itself is zero. -/ +@[simp] lemma num_edges_self_zero (G : CFGraph) (v : G.V) : + num_edges G v v = 0 := by + rw [num_edges, Multiset.card_eq_zero] + refine Multiset.filter_eq_nil.mpr ?_ + intro e h_inE h_eq + rw [or_self] at h_eq + rcases e with ⟨a, b⟩ + cases h_eq + exact G.loopless v h_inE + +/-- The degree, or valence, of a vertex as an integer. -/ +def vertex_degree (G : CFGraph) (v : G.V) : ℤ := + ∑ u : G.V, (num_edges G v u : ℤ) + +/-! +## The divisor group + +A *divisor* (`CFDiv G`) is an integer-valued function on the vertices of a chip-firing graph, +representing a distribution of chips (possibly negative, i.e. debt) across vertices. +The divisor group $\operatorname{Div}(G)$ is implemented as `CFDiv G`, the abelian group +of functions $V(G) \to \mathbb{Z}$ under pointwise addition. + +This section establishes basic operations on divisors: pointwise arithmetic lemmas, the +*firing move* at a single vertex (lending chips to all neighbors), the *borrowing move* +(the inverse operation), and the generalization to *set firing*. The firing vector +`firing_vector G v` is the principal divisor produced by firing vertex $v$ once. + +See: +- [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.3. +- [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definitions 1.5-1.6. +-/ + +/-- A *divisor* is a function from vertices to integers. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.3. -/ +abbrev CFDiv (G : CFGraph) := G.V → ℤ + +/-- The divisor with one chip at a specified vertex $v_{\mathrm{chip}}$ and zero chips elsewhere. -/ +def one_chip {G : CFGraph} (v_chip : G.V) : CFDiv G := + fun v => if v = v_chip then 1 else 0 + +-- Canonical simplifications for evaluations of one_chip. +@[simp] lemma one_chip_apply_v {G : CFGraph} (v : G.V) : one_chip v v = 1 := by + exact ite_eq_left rfl +@[simp] lemma one_chip_apply_other {G : CFGraph} (v w : G.V) : v ≠ w → one_chip v w = 0 := by + simp only [ne_eq, one_chip, ite_eq_right_iff, one_ne_zero, imp_false] + intro h + contrapose! h + rw [h] +@[simp] lemma one_chip_apply_other' {G : CFGraph} (v w : G.V) : w ≠ v → one_chip v w = 0 := by + simp only [ne_eq, one_chip, ite_eq_right_iff, one_ne_zero, imp_false, imp_self] + + +-- Properties of divisor arithmetic (add_apply, sub_apply, zero_apply, neg_apply, smul_apply +-- are provided by Mathlib for Pi types) + +/-- The result of firing a vertex $v$, starting from the divisor $D$. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.5. -/ +def firing_move (G : CFGraph) (D : CFDiv G) (v : G.V) : CFDiv G := + λ w => if w = v then D v - vertex_degree G v else D w + num_edges G v w + +/-- The result of borrowing at a vertex $v$, starting from a divisor $D$. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.5. -/ +def borrowing_move (G : CFGraph) (D : CFDiv G) (v : G.V) : CFDiv G := + λ w => if w = v then D v + vertex_degree G v else D w - num_edges G v w + +/-- The out-degree of `v` relative to `S`, counted with edge multiplicity. -/ +def outdeg_S (G : CFGraph) (S : Finset G.V) (v : G.V) : ℤ := + ∑ w ∈ (univ \ S), (num_edges G v w : ℤ) + +@[simp] theorem outdeg_S_eq_sum_filter (G : CFGraph) (S : Finset G.V) (v : G.V) : + outdeg_S G S v = ∑ w ∈ Finset.univ.filter (fun x => x ∉ S), + (num_edges G v w : ℤ) := by + refine Finset.sum_congr ?_ (fun _ _ => rfl) + ext w + simp + +theorem outdeg_S_nonneg (G : CFGraph) (S : Finset G.V) (v : G.V) : + 0 ≤ outdeg_S G S v := by + unfold outdeg_S + exact Finset.sum_nonneg fun _ _ => Int.natCast_nonneg _ + +theorem outdeg_S_antitone (G : CFGraph) {S T : Finset G.V} (h : S ⊆ T) (v : G.V) : + outdeg_S G T v ≤ outdeg_S G S v := by + unfold outdeg_S + exact Finset.sum_le_sum_of_subset_of_nonneg (Finset.compl_subset_compl.mpr h) + (fun _ _ _ => Int.natCast_nonneg _) + +/-- The result of firing a set $S$ of vertices, starting from a divisor $D$. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.6. -/ +def set_firing (G : CFGraph) (D : CFDiv G) (S : Finset G.V) : CFDiv G := + λ w => if w ∈ S then D w - outdeg_S G S w else D w + outdeg_S G Sᶜ w + +theorem set_firing_apply_of_mem (G : CFGraph) (D : CFDiv G) {S : Finset G.V} + {v : G.V} (hv : v ∈ S) : + set_firing G D S v = D v - outdeg_S G S v := by + simp [set_firing, hv] + +theorem set_firing_apply_of_not_mem (G : CFGraph) (D : CFDiv G) + {S : Finset G.V} {v : G.V} (hv : v ∉ S) : + set_firing G D S v = D v + outdeg_S G Sᶜ v := by + simp [set_firing, hv] + +theorem le_set_firing_apply_of_not_mem (G : CFGraph) (D : CFDiv G) + {S : Finset G.V} {v : G.V} (hv : v ∉ S) : + D v ≤ set_firing G D S v := by + rw [set_firing_apply_of_not_mem G D hv] + exact le_add_of_nonneg_right (outdeg_S_nonneg G Sᶜ v) + +/-- The principal divisor associated to firing a single vertex. -/ +def firing_vector (G : CFGraph) (v : G.V) : CFDiv G := + λ w => if w = v then -vertex_degree G v else num_edges G v w + +/-! +## Principal divisors and linear equivalence + +A *firing script* (`firing_script G = G.V → ℤ`) assigns an integer firing level to each vertex. +The associated *principal divisor* `prin G σ` records the net chip flow at each vertex when +the script $\sigma$ is applied: +$$ +(\operatorname{prin}_G \sigma)(v) = +\sum_u (\sigma(u)-\sigma(v)) \operatorname{num\_edges}_G(v,u). +$$ + +The subgroup of *principal divisors* `principal_divisors G` is generated by the firing vectors +`firing_vector G v` for all $v$. Two divisors $D$ and $D'$ are *linearly equivalent* +(`linear_equiv G D D'`) if their difference is a principal divisor. This defines an +equivalence relation on $\operatorname{Div}(G)$, and linearly equivalent +divisors have the same degree (see `linear_equiv_preserves_deg`). +-/ + +/-- The subgroup of principal divisors is generated by firing vectors at individual vertices. -/ +def principal_divisors (G : CFGraph) : AddSubgroup (CFDiv G) := + AddSubgroup.closure (Set.range (firing_vector G)) + +/-- Two divisors are *linearly equivalent* if their difference is a principal divisor. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.8. -/ +def linear_equiv (G : CFGraph) (D D' : CFDiv G) : Prop := + D' - D ∈ principal_divisors G + +/-- Principal divisors contain the firing vector at a vertex. -/ +private lemma mem_principal_divisors_firing_vector (G : CFGraph) (v : G.V) : + firing_vector G v ∈ principal_divisors G := AddSubgroup.subset_closure (Set.mem_range_self v) + +/-- Linear equivalence is reflexive. -/ +@[refl] lemma linear_equiv.refl (G : CFGraph) (D : CFDiv G) : linear_equiv G D D := by + unfold linear_equiv + simp only [sub_self, zero_mem] + +/-- Linear equivalence is symmetric. -/ +@[symm] lemma linear_equiv.symm {G : CFGraph} {D D' : CFDiv G} : + linear_equiv G D D' → linear_equiv G D' D := by + intro h + unfold linear_equiv at * + simpa only [sub_eq_add_neg, neg_add_rev, neg_neg] + using AddSubgroup.neg_mem (principal_divisors G) h + +/-- Linear equivalence is transitive. -/ +@[trans] lemma linear_equiv.trans {G : CFGraph} {D₁ D₂ D₃ : CFDiv G} : + linear_equiv G D₁ D₂ → linear_equiv G D₂ D₃ → linear_equiv G D₁ D₃ := by + intro h1 h2 + unfold linear_equiv at * + simpa only [sub_eq_add_neg, add_comm, add_left_comm, add_assoc, add_neg_cancel_comm_assoc] using + AddSubgroup.add_mem (principal_divisors G) h2 h1 + +/-- Linear equivalence is an equivalence relation on $\operatorname{Div}(G)$. -/ +theorem linear_equiv_is_equivalence (G : CFGraph) : Equivalence (linear_equiv G) := + ⟨linear_equiv.refl G, linear_equiv.symm, linear_equiv.trans⟩ + +/-- A *firing script* is an integer-valued function on vertices, recording how many times +each vertex is fired. Negative values represent borrowing. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 2.2. -/ +abbrev firing_script (G : CFGraph) := G.V → ℤ + +/-- The firing script that fires exactly the vertices in `S`, once each. -/ +def indicator_script (G : CFGraph) (S : Finset G.V) : firing_script G := + fun v => if v ∈ S then 1 else 0 + +/-- The group homomorphism sending a firing script $\sigma$ to the principal divisor +$$ +(\operatorname{prin}_G \sigma)(v) = +\sum_u (\sigma(u)-\sigma(v)) \operatorname{num\_edges}_G(v,u). +$$ + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 2.3; +`prin G σ` is the *negative* of the divisor $\operatorname{div}(\sigma)$ defined there, +since they implement a firing script as $D \mapsto D - \operatorname{div}(\sigma)$. -/ +def prin (G : CFGraph) : firing_script G →+ CFDiv G := + { + toFun := fun σ v => ∑ u : G.V, (σ u - σ v) * (num_edges G v u), + map_zero' := by + funext v + simp only [Pi.zero_apply, sub_self, zero_mul, sum_const_zero], + map_add' := by + intro σ₁ σ₂ + funext v + dsimp only [Pi.add_apply] + rw [← Finset.sum_add_distrib] + apply sum_congr rfl + intro u _ + ring, + } + +@[simp] theorem prin_apply (G : CFGraph) (σ : firing_script G) (v : G.V) : + prin G σ v = ∑ u : G.V, (σ u - σ v) * (num_edges G v u : ℤ) := rfl + +/-- Constant firing scripts have zero principal divisor. -/ +@[simp] theorem prin_const (G : CFGraph) (c : ℤ) : + prin G (fun _ : G.V => c) = 0 := by + funext v + rw [prin_apply] + simp + +@[simp] theorem prin_sub_const (G : CFGraph) (σ : firing_script G) (c : ℤ) : + prin G (fun v => σ v - c) = prin G σ := by + funext v + rw [prin_apply, prin_apply] + apply Finset.sum_congr rfl + intro u hu + ring + +/-- Firing a set once is the same as adding the principal divisor of its indicator script. -/ +theorem set_firing_eq_add_prin_indicator_script (G : CFGraph) (D : CFDiv G) + (S : Finset G.V) : + set_firing G D S = D + prin G (indicator_script G S) := by + classical + funext v + by_cases hv : v ∈ S + · simp [set_firing, indicator_script, prin_apply, outdeg_S, hv] + simp only [sub_mul, one_mul] + rw [Finset.sum_sub_distrib] + have hs : S.sum (fun x => (num_edges G v x : ℤ)) = + (univ : Finset G.V).sum (fun x => + (if x ∈ S then 1 else 0) * (num_edges G v x : ℤ)) := by simp + rw [← hs] + ring + · simp [set_firing, indicator_script, prin_apply, outdeg_S, hv] + +/-- A divisor is principal if and only if it equals `prin G σ` for some firing script `σ`. +This gives a concrete characterization of the subgroup `principal_divisors G`. -/ +lemma principal_iff_eq_prin (G : CFGraph) (D : CFDiv G) : + D ∈ principal_divisors G ↔ ∃ σ : firing_script G, D = prin G σ := by + unfold principal_divisors + constructor + · -- Forward direction + intro h_inp + -- Use the defining property of a subgroup closure + refine AddSubgroup.closure_induction ?_ ?_ ?_ ?_ h_inp + . -- Case 1: h_inp is a firing vector + intro x h_firing + rcases h_firing with ⟨v, rfl⟩ + let σ : firing_script G := λ u => if u = v then 1 else 0 + use σ + unfold firing_vector prin + funext w + dsimp only [AddMonoidHom.coe_mk, ZeroHom.coe_mk, σ] + by_cases h_eq : w = v + . -- Case w = v + simp only [h_eq, ↓reduceIte] + unfold vertex_degree + rw [← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro u _ + by_cases h_eq2 : u = v <;> simp only [h_eq2, num_edges_self_zero, CharP.cast_eq_zero, + neg_zero, ↓reduceIte, sub_self, mul_zero, zero_sub, Int.reduceNeg, neg_mul, one_mul] + . -- Case w ≠ v + simp only [h_eq, ↓reduceIte, num_edges_symmetric G v w, sub_zero, ite_mul, one_mul, + zero_mul, sum_ite_eq', mem_univ] + . -- Case 2: h_inp is zero divisor + use 0 + simp only [_root_.map_zero] + . -- Case 3: h_inp is a sum of two principal divisors + intros x y _ _ h_x_prin h_y_prin + rcases h_x_prin with ⟨σ₁, h_x_eq⟩ + rcases h_y_prin with ⟨σ₂, h_y_eq⟩ + rw [h_x_eq, h_y_eq] + use σ₁ + σ₂ + simp only [_root_.map_add] + . -- Case 4: h_inp is negation of a principal divisor + intro x _ h_x_prin + rcases h_x_prin with ⟨σ, h_x_eq⟩ + use -σ + rw [h_x_eq] + simp only [map_neg] + . -- Backward direction + intro h_prin + rcases h_prin with ⟨σ, h_eq⟩ + unfold prin at h_eq + let D₁ := ∑ u : G.V, (σ u) • (firing_vector G u) + have D1_principal :D₁ ∈ principal_divisors G := by + apply AddSubgroup.sum_mem _ _ + intro u _ + apply AddSubgroup.zsmul_mem _ _ + exact mem_principal_divisors_firing_vector G u + have D_eq : D₁ = D := by + rw [h_eq] + funext v + -- expand the definition of D₁ + dsimp only [AddMonoidHom.coe_mk, ZeroHom.coe_mk, D₁] + unfold firing_vector + -- Move that v into the sum on the left side + simp only [Finset.sum_apply] + simp only [Pi.smul_apply, Int.zsmul_eq_mul, mul_ite, mul_neg] + have: ∀ (u : G.V), (σ u - σ v) * ↑(num_edges G v u) = σ u * ↑(num_edges G v u) - σ v * ↑(num_edges G v u) := by intro u; ring + simp only [this] + + have h (x : G.V) : (if v = x then -(σ x * vertex_degree G x) else σ x * ↑(num_edges G x v) ) = σ x * (↑(num_edges G x v) ) - σ x * ( (if v = x then vertex_degree G x else 0)) := by + by_cases h : v = x <;> simp only [h, ↓reduceIte, mul_zero, sub_zero, num_edges_self_zero, + CharP.cast_eq_zero, zero_sub] + + simp only [h] + rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib] + suffices ∑ x : G.V, σ x * (if v = x then vertex_degree G x else 0) = ∑ x : G.V, (σ v * ↑(num_edges G v x)) by + rw [this] + simp only [num_edges_symmetric] + + dsimp only [vertex_degree] + rw [← Finset.mul_sum] + simp only [mul_ite, mul_zero, sum_ite_eq, mem_univ, ↓reduceIte] + rw [← D_eq] + exact D1_principal + +/-! +## Effective divisors and winnability + +A divisor is *effective* if it assigns a nonnegative number of chips to every vertex. +The divisor group carries a natural partial order, where $D_1 \le D_2$ if and only if +$D_1(v) \le D_2(v)$ for all vertices $v$. Effectivity is equivalent to $D \ge 0$. +The submonoid of effective divisors is denoted `Eff G`. + +A divisor $D$ is *winnable* if it is linearly equivalent to some effective divisor. +Equivalently, the players can collectively win the dollar game starting from position $D$. +-/ + +/-- A divisor is *effective* if it assigns a nonnegative integer to every vertex. +Equivalently, it is at least $0$. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.13. -/ +def effective {G : CFGraph} (D : CFDiv G) : Prop := + ∀ v : G.V, D v ≥ 0 + + +/-- The submonoid of effective divisors is denoted `Eff G`. -/ +def Eff (G : CFGraph) : AddSubmonoid (CFDiv G) := + { carrier := {D : CFDiv G | effective D}, + zero_mem' := by + simp only [effective, ge_iff_le, Set.mem_ofPred_eq, Pi.zero_apply, Std.le_refl, implies_true] + add_mem' := by + intro D₁ D₂ h_eff1 h_eff2 v + exact add_nonneg (h_eff1 v) (h_eff2 v) } + +@[simp] lemma mem_Eff {G : CFGraph} {D : CFDiv G} : D ∈ Eff G ↔ effective D := Iff.rfl + +/-- A one-chip divisor is effective. -/ +lemma eff_one_chip {G : CFGraph} (v : G.V) : effective (one_chip v) := by + intro w + dsimp only [one_chip] + by_cases h_eq : w = v <;> simp only [h_eq, ↓reduceIte, ge_iff_le, Std.le_refl, zero_le_one] + +/-- The divisor $D_1-D_2$ is effective if and only if $D_1 \ge D_2$. -/ +lemma sub_eff_iff_geq {G : CFGraph} (D₁ D₂ : CFDiv G) : effective (D₁ - D₂) ↔ D₁ ≥ D₂ := + forall_congr' (fun _ => sub_nonneg) + +/-- A divisor is winnable if it is linearly equivalent to an effective divisor. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.14. -/ +def winnable (G : CFGraph) (D : CFDiv G) : Prop := + ∃ D' ∈ Eff G, linear_equiv G D D' + + +/-! +## The degree homomorphism and the Laplacian + +The *degree* of a divisor $D$ is $\deg(D) = \sum_v D(v)$, the total number of chips. +It is a group homomorphism $\mathrm{Div}(G) \to \mathbb{Z}$. +Principal divisors have degree zero, so linearly equivalent divisors have equal degree. + +The *Laplacian matrix* `laplacian_matrix G` is the matrix $L = \mathrm{Deg}(G) - A$, where +$\mathrm{Deg}(G)$ is the diagonal degree matrix and $A$ is the adjacency matrix. +Applying the Laplacian to a firing script produces the corresponding principal divisor. +-/ + +/-- The degree of a divisor is the sum of its values over all vertices. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.4. -/ +def deg {G : CFGraph} : CFDiv G →+ ℤ := { + toFun := λ D => ∑ v, D v, + map_zero' := by + simp only [Pi.zero_apply, sum_const_zero], + map_add' := by + intro D₁ D₂ + simp only [Pi.add_apply, sum_add_distrib], +} + +@[simp] lemma deg_one_chip {G : CFGraph} (v : G.V) : deg (one_chip v) = 1 := by + simp only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk, one_chip, sum_ite_eq', mem_univ, ↓reduceIte] + +/-- Effective divisors have nonnegative degree. -/ +lemma deg_of_eff_nonneg (D : CFDiv G) : + effective D → deg D ≥ 0 := by + intro h_eff + exact Finset.sum_nonneg fun v _ => h_eff v + +/-- The only effective divisor of degree 0 is 0. -/ +lemma eff_degree_zero (D : CFDiv G) : effective D → deg D = 0 → D = 0 := by + intro h_eff h_deg + funext v + exact (Finset.sum_eq_zero_iff_of_nonneg (fun w _ => h_eff w)).1 + (by simpa only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] using h_deg) v (Finset.mem_univ v) + +/-- The degree of a firing vector is zero. -/ +private lemma deg_firing_vector_eq_zero (G : CFGraph) (v_fire : G.V) : + deg (firing_vector G v_fire) = 0 := by + dsimp only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk, firing_vector] + rw [Finset.sum_ite] + have h_filter_eq_single : Finset.filter (fun x => x = v_fire) univ = {v_fire} := by + ext x; simp only [eq_comm, Finset.mem_filter, mem_univ, true_and, Finset.mem_singleton] + rw [h_filter_eq_single, Finset.sum_singleton] + have h_filter_eq_erase : Finset.filter (fun x => ¬x = v_fire) univ = Finset.univ.erase v_fire := by + ext x + simp only [Finset.mem_filter, mem_univ, true_and, mem_erase, and_true] + rw [h_filter_eq_erase] + simp only [vertex_degree, mem_univ, sum_erase_eq_sub, num_edges_self_zero, CharP.cast_eq_zero, + sub_zero, neg_add_cancel] + +/-- Every principal divisor has degree zero. -/ +private lemma degree_of_principal_divisor_is_zero (G : CFGraph) (h : CFDiv G) : + h ∈ principal_divisors G → deg h = 0 := by + intro h_mem_princ + refine AddSubgroup.closure_induction ?_ ?_ ?_ ?_ h_mem_princ + · rintro x ⟨v, rfl⟩ + exact deg_firing_vector_eq_zero G v + · simp only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk, Pi.zero_apply, sum_const_zero] + · intro x y _ _ hx hy + rw [deg.map_add, hx, hy, add_zero] + · intro x _ hx + rw [deg.map_neg, hx, neg_zero] + +/-- Linearly equivalent divisors have the same degree. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Proposition 1.15. -/ +theorem linear_equiv_preserves_deg (G : CFGraph) (D D' : CFDiv G) (h_equiv : linear_equiv G D D') : + deg D = deg D' := by + unfold linear_equiv at h_equiv + apply degree_of_principal_divisor_is_zero at h_equiv + rw [map_sub] at h_equiv + linarith + +/-- An effective divisor of degree $k_1+k_2$ can be decomposed into a sum of two effective +divisors of degrees $k_1$ and $k_2$, respectively. -/ +lemma effective_divisor_decomposition (G : CFGraph) (E'' : CFDiv G) (k₁ k₂ : ℕ) + (h_effective : effective E'') (h_deg : deg E'' = k₁ + k₂) : + ∃ (E₁ E₂ : CFDiv G), + effective E₁ ∧ effective E₂ ∧ + deg E₁ = k₁ ∧ deg E₂ = k₂ ∧ + E'' = E₁ + E₂ := by + + let can_split (E : CFDiv G) (a b : ℕ): Prop := + ∃ (E₁ E₂ : CFDiv G), + effective E₁ ∧ effective E₂ ∧ + deg E₁ = a ∧ deg E₂ = b ∧ + E = E₁ + E₂ + + let P (a b : ℕ) : Prop := ∀ (E : CFDiv G), + effective E → deg E = a + b → can_split E a b + + have h_ind (a b : ℕ): P a b := by + induction a with + | zero => + . -- Base case: a = 0 + intro E h_eff h_deg + use (0 : CFDiv G), E + constructor + -- E₁ is effective + dsimp only [effective, Pi.zero_apply] + intro v + linarith + -- E₂ is effective + constructor + exact h_eff + -- deg E₁ = 0 + constructor + simp only [_root_.map_zero, CharP.cast_eq_zero] + -- deg E₂ = b + constructor + rw[h_deg] + simp only [CharP.cast_eq_zero, zero_add] + -- E = 0 + E + simp only [zero_add] + | succ a ha => + . -- Inductive step: assume P a b holds, prove P (a+1) b + dsimp only [Int.natCast_add, Int.cast_ofNat_Int, P] at * + intro E E_effective E_deg + have ex_v : ∃ (v : G.V), E v ≥ 1 := by + by_contra h_contra + push Not at h_contra + have h_sum : deg E = 0 := by + dsimp only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] + rw [Finset.sum_eq_zero_iff_of_nonneg (fun v _ => E_effective v)] + intro v hv + have h_nonneg : 0 ≤ E v := E_effective v + specialize h_contra v + linarith + rw [h_sum] at E_deg + linarith + rcases ex_v with ⟨v, hv_ge_one⟩ + let E' := E - one_chip v + have h_E'_effective : effective E' := by + intro w + dsimp only [Pi.sub_apply, E'] + by_cases hw : w = v + · rw [hw] + specialize hv_ge_one + dsimp only [one_chip] + simp only [↓reduceIte, Int.sub_nonneg] + linarith + · specialize E_effective w + dsimp only [one_chip] + simp only [hw, ↓reduceIte, sub_zero, ge_iff_le] + linarith + specialize ha E' h_E'_effective + have h_deg_E' : deg E' = a + b := by + dsimp only [E']; simp only [map_sub, deg_one_chip]; omega + apply ha at h_deg_E' + rcases h_deg_E' with ⟨E₁, E₂, h_E1_eff, h_E2_eff, h_deg_E1, h_deg_E2, h_eq_split⟩ + use E₁ + one_chip v, E₂ + -- Check E₁ + one_chip v is effective + constructor + apply (Eff G).add_mem + -- E₁ is effective + exact h_E1_eff + -- one_chip v is effective + intro w + dsimp only [one_chip] + simp only [ge_iff_le] + by_cases hw : w = v + rw [hw] + simp only [↓reduceIte, zero_le_one] + simp only [hw, ↓reduceIte, Std.le_refl] + -- E₂ is effective + constructor + exact h_E2_eff + -- deg (E₁ + one_chip v) = a + 1 + constructor + simp only [_root_.map_add, h_deg_E1, deg_one_chip, Nat.cast_add, Nat.cast_one] + -- deg E₂ = b + constructor + exact h_deg_E2 + -- E = (E₁ + one_chip v) + E₂ + dsimp only [E'] at h_eq_split + rw [add_assoc, add_comm (one_chip v), ← add_assoc, ← h_eq_split] + abel + + exact h_ind k₁ k₂ E'' h_effective h_deg + +open Matrix + +/-- The Laplacian matrix of a CFGraph. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 2.6. -/ +def laplacian_matrix (G : CFGraph) : Matrix G.V G.V ℤ := + λ i j => if i = j then vertex_degree G i else - (num_edges G i j) + +-- Note: The Laplacian matrix L is given by Deg(G) - A, where Deg(G) is the diagonal +-- matrix of degrees and A is the adjacency matrix. +-- This matrix can be used to represent the effect of a firing script on a divisor. + +/-- Applies the Laplacian matrix to a firing script and a current divisor to obtain a +new divisor. -/ +def apply_laplacian (G : CFGraph) (σ : firing_script G) (D: CFDiv G) : CFDiv G := + fun v => (D v) - (laplacian_matrix G).mulVec σ v + +/-! +## q-effective divisors + +Fix a vertex $q$. A divisor $D$ is *$q$-effective* if $D(v) \geq 0$ for all $v \neq q$; +it may have an arbitrary (possibly negative) value at $q$ itself. The structure `q_eff_div` +packages such a divisor with its proof of $q$-effectivity. + +A key fact for connected graphs is that every divisor is linearly equivalent to a +$q$-effective divisor (`q_effective_exists`). The proof goes via the notion of a +*benevolent* set: a set $S$ is benevolent if any divisor can be made to have all its +debt concentrated on $S$ via firing moves. +-/ + +/-- A divisor is *$q$-effective* if it has a nonnegative number of chips at every vertex +except possibly $q$. -/ +def q_effective {G : CFGraph} (q : G.V) (D : CFDiv G) : Prop := + ∀ v : G.V, v ≠ q → D v ≥ 0 + +/-- A divisor bundled with a proof that it is $q$-effective. -/ +structure q_eff_div (G : CFGraph) (q : G.V) where + (D : CFDiv G) (h_eff : q_effective q D) + +/-- A set of vertices is benevolent if it is possible to concentrate all debt on this set. -/ +def benevolent (G : CFGraph) (S : Finset G.V) : Prop := + ∀ (D : CFDiv G), ∃ (E : CFDiv G), linear_equiv G D E ∧ (∀ (v : G.V), E v < 0 → v ∈ S) + +/-- In a connected graph, any nonempty set is benevolent. -/ +lemma benevolent_of_nonempty {G : CFGraph} (h_conn : graph_connected G) (S : Finset G.V) (h_nonempty : S.Nonempty) : + benevolent G S := by + by_cases h : S = Finset.univ + · -- Case: S = G.V + intro D + use D + -- Verify the first part of the conjunction + constructor + exact linear_equiv.refl G D + -- Verify second part + intro v h_neg + rw [h] + simp only [mem_univ] + · -- Case: S ≠ G.V + let h_conn' := h_conn -- Unsimplified copy for later + dsimp only [graph_connected] at h_conn + specialize h_conn S + have : ∃ (v w : G.V), v ∈ S ∧ w ∉ S := by + let v := Classical.choose h_nonempty + have v_in_S : v ∈ S := Classical.choose_spec h_nonempty + have : (univ \ S).Nonempty := by + contrapose! h + simp only [sdiff_eq_empty_iff_subset, univ_subset_iff] at h + exact h + let w := Classical.choose this + have h_vw : w ∉ S := by + have := Classical.choose_spec this + simp only [mem_sdiff, mem_univ, true_and] at this + exact this + use v, w + have h_vw := h_conn this + rcases h_vw with ⟨v,h_v,w,h_w,h_edge⟩ + let T := insert w S + have h_T_nonempty : T.Nonempty := by + use w + simp only [mem_insert, true_or, T] + have ih := benevolent_of_nonempty h_conn' T h_T_nonempty + intro D + specialize ih D + rcases ih with ⟨E1, h_lequiv_1, h_eff_S⟩ + -- Now need to adjust E1 to get E + have : ∃ E : CFDiv G, linear_equiv G E1 E ∧ (∀ v : G.V, E v < 0 → v ∈ S) := by + let fire := firing_vector G v + have p_f : fire ∈ principal_divisors G := mem_principal_divisors_firing_vector G v + let k := max 0 (-(E1 w)) + let E := E1 + k • fire + use E + constructor + · -- Verify linear equivalence + unfold linear_equiv + have h_diff : E - E1 = k • fire := by + simp only [zsmul_eq_mul, add_sub_cancel_left, E] + rw [h_diff] + exact AddSubgroup.zsmul_mem _ p_f k + · -- Verify effectiveness outside S + intro x h_E_neg + by_cases h_x_eq_w : x = w + · -- Case x = w + exfalso + rw [h_x_eq_w] at h_E_neg + dsimp only [Pi.add_apply, Pi.smul_apply, Int.zsmul_eq_mul, E] at h_E_neg + contrapose! h_E_neg + simp only [k] + by_cases h : -(E1 w) ≥ 0 + . -- Case : E1 w nonpositive + have : max 0 (-(E1 w)) = -(E1 w) := by + simp only [sup_eq_right, Int.neg_nonneg]; linarith + rw [this] + have : E1 w + -E1 w * fire w = (-E1 w) * (fire w -1) := by ring + rw [this] + apply mul_nonneg h + -- Goal: fire w -1 ≥ 0 + dsimp only [firing_vector, fire] + have : ¬ (w = v) := by + contrapose! h_w + rw [← h_w] at h_v + exact h_v + simp only [this, ↓reduceIte, Int.sub_nonneg, Nat.one_le_cast, ge_iff_le] + linarith [h_edge] + . -- Case : E1 w positive + push Not at h + dsimp only [max, Int.neg_nonneg] + split_ifs at * with hle + · linarith + · simp only [zero_mul, add_zero] at *; linarith + . -- Case : x ≠ w + have h_T := h_eff_S x + by_contra! x_nin_S + have h_xT : x ∉ T := by + contrapose! x_nin_S with x_in_T + dsimp only [T] at x_in_T + simp only [mem_insert, h_x_eq_w, false_or] at x_in_T + exact x_in_T + specialize h_eff_S x + contrapose! h_eff_S + simp only [h_xT, not_false_eq_true, and_true] + contrapose! h_E_neg with h_E1 + -- Goal: 0 ≤ E x + dsimp only [Pi.add_apply, Pi.smul_apply, Int.zsmul_eq_mul, E] + apply add_nonneg h_E1 + -- Goal : 0 ≤ k * fire x + apply mul_nonneg + -- Show 0 ≤ k + dsimp only [k] + simp only [le_sup_left] + -- Show 0 ≤ fire x + dsimp only [firing_vector, fire] + have : ¬ (x = v) := by + contrapose! x_nin_S with x_eq_v + rw [x_eq_v] + exact h_v + simp only [this, ↓reduceIte, Nat.cast_nonneg] + rcases this with ⟨E, h_lequiv_2, h_eff_S_final⟩ + use E + constructor + · -- Verify linear equivalence + exact h_lequiv_1.trans h_lequiv_2 + · -- Verify effectiveness outside S + exact h_eff_S_final +termination_by ((univ : Finset G.V).card - S.card) +decreasing_by + have h_succ: (insert w S).card = S.card + 1 := by + apply Finset.card_eq_succ.mpr + use w, S + rw [h_succ] + refine Nat.sub_succ_lt_self univ.card S.card ?_ + have : (insert w S).card ≤ (univ : Finset G.V).card := by + simpa only [card_univ] using Finset.card_le_univ (insert w S) + linarith + +/-- In a connected graph, every divisor is linearly equivalent to a $q$-effective divisor. + +Equivalently, every divisor can have all of its debt concentrated at $q$. -/ +theorem q_effective_exists {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : + ∃ (E : CFDiv G), q_effective q E ∧ linear_equiv G D E := by + have h_bene := benevolent_of_nonempty h_conn {q} (by use q; simp only [Finset.mem_singleton]) D + rcases h_bene with ⟨E,h_equiv, h_eff⟩ + have : q_effective q E := by + intro v v_ne_q + specialize h_eff v + contrapose! h_eff + simp only [h_eff, Finset.mem_singleton, true_and] + exact v_ne_q + exact ⟨E,this, h_equiv⟩ + + +/-! +## The q-reduction partial order + +A firing script $\sigma$ is a *$q$-reducer* if $\sigma(q) \leq \sigma(v)$ for all $v$, +meaning $q$ is fired the least (or not at all relative to the others). The relation +`reduces_to G q D₁ D₂` holds when $D_2$ is obtained from $D_1$ by applying a $q$-reducer +script, i.e. $D_2 = D_1 + \mathrm{prin}(\sigma)$ for some $q$-reducer $\sigma$. + +This relation is reflexive and transitive, and in connected graphs it is also antisymmetric +(`reduces_to_antisymmetric`), making it a partial order on $q$-effective divisors. The +antisymmetry relies on the fact that a firing script with trivial principal divisor must +be constant (`constant_script_of_zero_prin`). + +Two further facts about this order do most of the work in the next section: the number of +chips at $q$ is monotone along the order (`reduces_to_q_mono`), and a script that is a +$q$-reducer in both directions has zero principal divisor +(`prin_eq_zero_of_two_sided_reducer`) — a connectivity-free shadow of antisymmetry. +-/ + +/-- A firing script $\sigma$ is a *$q$-reducer* if $q$ is fired the minimum number of times: +$\sigma(q) \le \sigma(v)$ for all vertices $v$. -/ +def q_reducer (G : CFGraph) (q : G.V) (σ : firing_script G) : Prop := + ∀ v : G.V, σ q ≤ σ v + +/-- The relation `reduces_to G q D₁ D₂` holds when $D_2$ is obtained from $D_1$ by +applying a $q$-reducer script: +$$ +D_2 = D_1 + \operatorname{prin}_G(\sigma) +$$ +for some $\sigma$ with $\sigma(q) \le \sigma(v)$ for all vertices $v$. -/ +def reduces_to (G : CFGraph) (q : G.V) (D₁ D₂: CFDiv G) : Prop := + ∃ σ : firing_script G, q_reducer G q σ ∧ D₂ = D₁ + prin G σ + +/-- The `reduces_to` relation is reflexive: any divisor reduces to itself via the zero script. -/ +private lemma reduces_to_reflexive (G : CFGraph) (q : G.V) (D : CFDiv G) : + reduces_to G q D D := by + refine ⟨0, by simp only [q_reducer, Pi.zero_apply, Std.le_refl, implies_true], + by simp only [_root_.map_zero, add_zero]⟩ + +/-- The `reduces_to` relation is transitive: composing two $q$-reducer scripts yields a +$q$-reducer script. -/ +private lemma reduces_to_transitive (G : CFGraph) (q : G.V) (D₁ D₂ D₃ : CFDiv G) : + reduces_to G q D₁ D₂ → reduces_to G q D₂ D₃ → reduces_to G q D₁ D₃ := by + rintro ⟨σ₁, h_reducer_1, h_D2_eq⟩ ⟨σ₂, h_reducer_2, h_D3_eq⟩ + use σ₁ + σ₂ + refine ⟨?_, ?_⟩ + · + intro v + repeat rw [Pi.add_apply] + apply add_le_add (h_reducer_1 v) (h_reducer_2 v) + · + rw [(prin G).map_add, ← add_assoc] + rw [← h_D2_eq, ← h_D3_eq] + +/-- Along the $q$-reduction order, the number of chips at $q$ is monotone non-decreasing: +a $q$-reducer script sends a nonnegative number of chips toward $q$. -/ +private lemma reduces_to_q_mono (G : CFGraph) (q : G.V) {D₁ D₂ : CFDiv G} : + reduces_to G q D₁ D₂ → D₁ q ≤ D₂ q := by + rintro ⟨σ, h_reducer, h_eq⟩ + have h_prin_q : (prin G σ) q ≥ 0 := by + rw [prin_apply] + apply Finset.sum_nonneg + intro e _ + apply mul_nonneg + linarith [h_reducer e] + exact Int.natCast_nonneg _ + rw [h_eq, Pi.add_apply] + linarith + +/-- In a connected graph, a firing script with zero principal divisor must be constant. +This is the key step in proving antisymmetry of `reduces_to`. -/ +private lemma constant_script_of_zero_prin {G : CFGraph} (h_conn : graph_connected G) (σ : firing_script G) : prin G σ = 0 → ∀ (v w : G.V), σ v = σ w := by + intro zero_eq + let min_exists := Finset.exists_min_image Finset.univ σ + (by use Classical.arbitrary G.V; simp only [mem_univ]) + rcases min_exists with ⟨q, ⟨_,h_reducer⟩⟩ + have h_reducer : ∀ v : G.V, σ q ≤ σ v := by + intro v; specialize h_reducer v + simp only [mem_univ, forall_const] at h_reducer; exact h_reducer + let S := Finset.univ.filter (λ v => σ v = σ q) + have q_in_S : q ∈ S := by + dsimp only [S] + simp only [Finset.mem_filter, mem_univ, and_self] + have S_full : ∀ v : G.V, v ∈ S := by + by_contra! v_nin_S + rcases v_nin_S with ⟨v, h_v⟩ + have h : ∃ (u v : G.V), u ∈ S ∧ v ∉ S := by + use q, v + have := h_conn S h + rcases this with ⟨u, h_u_in_S, w, h_w_nin_S, h_edge⟩ + have nonneg_terms: ∀ w : G.V, (σ w - σ u) * (num_edges G u w : ℤ) ≥ 0 := by + intro w + have h_σw_ge_σu : σ w - σ u ≥ 0 := by + dsimp only [S] at h_u_in_S h_w_nin_S + simp only [Finset.mem_filter, mem_univ, true_and] at h_u_in_S + specialize h_reducer w + linarith + apply Int.mul_nonneg h_σw_ge_σu (Nat.cast_nonneg _) + have pos_term : ∃ (w : G.V), (σ w - σ u) * (num_edges G u w : ℤ) > 0 := by + use w + apply Int.mul_pos + · -- Show σ w - σ u > 0 + dsimp only [S] at h_u_in_S h_w_nin_S + simp only [Finset.mem_filter, mem_univ, true_and] at h_u_in_S h_w_nin_S + specialize h_reducer w + rw [h_u_in_S] + apply lt_of_le_of_ne at h_reducer + have : ¬ σ q = σ w := by + contrapose! h_w_nin_S + rw [← h_w_nin_S] + apply h_reducer at this + linarith + · -- Show num_edges G u w > 0 + simp only [Int.natCast_pos, h_edge] + have : ∑ u_1 : G.V, (σ u_1 - σ u) * ↑(num_edges G u u_1) >0 := by + apply Finset.sum_pos' + intro i _ + exact nonneg_terms i + rcases pos_term with ⟨w, h_pos⟩ + use w + simp only [mem_univ, true_and] + exact h_pos + -- apply zero_eq at u + have zero_eq_at_u: (prin G) σ u = 0 := by + simp only [zero_eq, Pi.zero_apply] + rw [prin_apply] at zero_eq_at_u + linarith [zero_eq_at_u] + intro v w + have eq_q : ∀ v : G.V, σ v = σ q := by + intro v; specialize S_full v + dsimp only [S] at S_full; simp only [Finset.mem_filter, mem_univ, true_and] at S_full + exact S_full + rw [eq_q v, eq_q w] + +/-- A script that is a $q$-reducer in both directions is constant, and hence has zero +principal divisor. This is antisymmetry at the level of scripts; unlike +`reduces_to_antisymmetric` it requires no connectivity hypothesis. -/ +private lemma prin_eq_zero_of_two_sided_reducer (G : CFGraph) (q : G.V) (σ : firing_script G) + (h₁ : q_reducer G q σ) (h₂ : q_reducer G q (-σ)) : prin G σ = 0 := by + have h_const : ∀ v : G.V, σ v = σ q := by + intro v + have hv₂ := h₂ v + repeat rw [Pi.neg_apply] at hv₂ + linarith [h₁ v] + rw [show σ = (fun _ : G.V => σ q) from funext h_const, prin_const] + +/-- In a connected graph, the `reduces_to` relation is antisymmetric, completing the proof +that it is a partial order on $q$-effective divisors. -/ +private lemma reduces_to_antisymmetric {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D₁ D₂ : CFDiv G) : + reduces_to G q D₁ D₂ → reduces_to G q D₂ D₁ → D₁ = D₂ := by + intro h_red_12 h_red_21 + rcases h_red_12 with ⟨σ₁, h_reducer_1, h_D2_eq⟩ + rcases h_red_21 with ⟨σ₂, h_reducer_2, h_D1_eq⟩ + rw [h_D2_eq, add_assoc, ← (prin G).map_add] at h_D1_eq + let σ := σ₁ + σ₂ + have prin_sum_zero : prin G (σ) = 0 := by + simp only [_root_.map_add, left_eq_add] at h_D1_eq + rw [← (prin G).map_add] at h_D1_eq + exact h_D1_eq + + apply constant_script_of_zero_prin h_conn at prin_sum_zero + + -- σ₁ is a q-reducer in both directions, since σ₁ + σ₂ is constant + have h_reducer_1' : q_reducer G q (-σ₁) := by + intro v + repeat rw [Pi.neg_apply] + specialize h_reducer_2 v + dsimp only [Pi.add_apply, σ] at prin_sum_zero + specialize prin_sum_zero q v + linarith + have h_prin_zero : prin G σ₁ = 0 := + prin_eq_zero_of_two_sided_reducer G q σ₁ h_reducer_1 h_reducer_1' + rw [h_prin_zero] at h_D2_eq + rw [h_D2_eq] + simp only [add_zero] + +/-! +## q-reduced divisors + +A $q$-effective divisor $D$ is *$q$-reduced* if, for every nonempty set +$S \subseteq V(G) \setminus \{q\}$, some vertex in $S$ would go into debt if $S$ were fired. +Equivalently, $D$ is the maximum element of its linear equivalence class in the $q$-reduction +partial order. + +The main results of this section are: +- Every divisor has a unique $q$-reduced representative (`exists_q_reduced_representative`, + `q_reduced_unique`). +- A divisor is winnable if and only if its $q$-reduced representative is effective + (`winnable_iff_q_reduced_effective`). + +The existence proof proceeds by defining an `active` vertex (one that can still be fired +while maintaining $q$-effectivity) and showing that the `reduction_excess` — the total chips +at active vertices — strictly decreases at each reduction step. +-/ + +/-- A set of vertices is legal for `D` if firing it leaves every vertex in the set +nonnegative. -/ +def legal_set (G : CFGraph) (D : CFDiv G) (S : Finset G.V) : Prop := + ∀ v ∈ S, outdeg_S G S v ≤ D v + +instance (G : CFGraph) (D : CFDiv G) (S : Finset G.V) : + Decidable (legal_set G D S) := by + unfold legal_set + infer_instance + +@[simp] theorem legal_set_empty (G : CFGraph) (D : CFDiv G) : + legal_set G D (∅ : Finset G.V) := by + intro v hv + simp at hv + +theorem effective_set_firing_of_legal_set (G : CFGraph) {D : CFDiv G} + {S : Finset G.V} (hD : effective D) (hS : legal_set G D S) : + effective (set_firing G D S) := by + intro v + by_cases hv : v ∈ S + · rw [set_firing_apply_of_mem G D hv] + have h := hS v hv + omega + · exact le_trans (hD v) (le_set_firing_apply_of_not_mem G D hv) + +/-- Firing a legal set preserves effectivity away from a distinguished vertex. -/ +theorem q_effective_set_firing_of_legal_set (G : CFGraph) {q : G.V} {D : CFDiv G} + {S : Finset G.V} (hD : q_effective q D) (hS : legal_set G D S) : + q_effective q (set_firing G D S) := by + intro v hvq + by_cases hv : v ∈ S + · rw [set_firing_apply_of_mem G D hv] + exact sub_nonneg.mpr (hS v hv) + · exact le_trans (hD v hvq) (le_set_firing_apply_of_not_mem G D hv) + +theorem legal_set_union (G : CFGraph) {D : CFDiv G} {S T : Finset G.V} + (hS : legal_set G D S) (hT : legal_set G D T) : + legal_set G D (S ∪ T) := by + intro v hv + rcases Finset.mem_union.mp hv with hv | hv + · exact le_trans (outdeg_S_antitone G Finset.subset_union_left v) (hS v hv) + · exact le_trans (outdeg_S_antitone G Finset.subset_union_right v) (hT v hv) + +/-- A divisor is $q$-reduced if it is effective away from $q$, and firing any nonempty +set of vertices disjoint from $q$ puts some vertex of that set into debt. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 3.4. -/ +def q_reduced (G : CFGraph) (q : G.V) (D : CFDiv G) : Prop := + q_effective q D ∧ + ∀ S : Finset G.V, q ∉ S → S.Nonempty → ¬ legal_set G D S + +/-- A nonempty set avoiding `q` contains a vertex that would go into debt when fired +from a `q`-reduced divisor. -/ +theorem q_reduced.exists_lt_outdeg {G : CFGraph} {q : G.V} {D : CFDiv G} + (hred : q_reduced G q D) {S : Finset G.V} (hq : q ∉ S) (hS : S.Nonempty) : + ∃ v ∈ S, D v < outdeg_S G S v := by + by_contra! h + exact hred.2 S hq hS h + + + +/-- Any firing script $\sigma$ attains its maximum on a nonempty set $S$, and applying +$\sigma$ removes at least $\operatorname{outdeg}_S(v)$ chips from each $v \in S$. -/ +private lemma maxset_of_script (G : CFGraph) (σ : firing_script G) : ∃ S : Finset G.V, S.Nonempty ∧ ∀ v ∈ S, (∀ w : G.V, σ w ≤ σ v ∧ (w ∈ S → σ w = σ v)) ∧ -(prin G σ v) ≥ outdeg_S G S v := by + let max_exists := Finset.exists_max_image Finset.univ σ + (by use Classical.arbitrary G.V; simp only [mem_univ]) + rcases max_exists with ⟨w, ⟨_,w_argmax⟩⟩ + let S := Finset.univ.filter (σ · = σ w) + use S + constructor + -- Show S is nonempty + use w; dsimp only [S]; simp only [Finset.mem_filter, mem_univ, and_self] + intro x x_in_S + have h_x : σ x = σ w := by + dsimp only [S] at x_in_S; simp only [Finset.mem_filter, mem_univ, + true_and] at x_in_S; exact x_in_S + + constructor + -- Maximality condition + intro y + constructor + · -- Show σ y ≤ σ x + specialize w_argmax y (by simp only [mem_univ]) + rw [h_x]; exact w_argmax + · -- Show that if y ∈ S, then σ y = σ x + intro y_in_S + dsimp only [S] at y_in_S; simp only [Finset.mem_filter, mem_univ, true_and] at y_in_S + rw [h_x]; exact y_in_S + -- Show the outdegree inequality + rw [prin_apply] + rw [outdeg_S_eq_sum_filter] + simp only [ge_iff_le] + rw [← Finset.sum_neg_distrib] + rw [← Finset.sum_filter_add_sum_filter_not univ (fun x ↦ x ∉ S)] + + have : ∑ x_1 ∈ Finset.filter (fun x ↦ ¬x ∉ S) univ, -((σ x_1 - σ x) * ↑(num_edges G x x_1)) = 0 := by + apply Finset.sum_eq_zero + intro y h_y + have h_y : y ∈ S := by simp only [Decidable.not_not, subset_univ, + filter_mem_eq_of_subset] at h_y; exact h_y + have h_σy : σ y = σ x := by + dsimp only [S] at h_y; simp only [Finset.mem_filter, mem_univ, true_and] at h_y + rw [h_x, h_y] + simp only [h_σy, sub_self, zero_mul, neg_zero] + rw [this, Int.add_zero] + apply Finset.sum_le_sum + intro u h_u_notin_S + by_cases h : num_edges G x u = 0 + · -- Case: num_edges G x u = 0 + simp only [h, CharP.cast_eq_zero, mul_zero, neg_zero, Std.le_refl] + . -- Case: num_edges G x u ≠ 0 + have h : num_edges G x u > 0 := by + exact Nat.pos_iff_ne_zero.mpr h + suffices 1 ≤ σ x - σ u by + rw [neg_mul_eq_neg_mul] + simp only [neg_sub, Int.natCast_pos, h, le_mul_iff_one_le_left, this] + suffices 0 < σ x - σ u by + exact Int.le_of_sub_one_lt this + dsimp only [S] at h_u_notin_S; simp only [Finset.mem_filter, mem_univ, true_and] at h_u_notin_S + rw [h_x] + specialize w_argmax u (by simp only [mem_univ]) + linarith [lt_of_le_of_ne w_argmax h_u_notin_S] + +/-- If applying a script $\sigma$ to a $q$-effective divisor yields a $q$-reduced divisor, +then $\sigma$ is a $q$-reducer: a $q$-reduced divisor can only be reached from a +$q$-effective one by firing $q$ the least. -/ +private lemma q_reducer_of_add_princ_reduced (G : CFGraph) (q : G.V) (D : CFDiv G) (σ : firing_script G) : + q_reduced G q (D + prin G σ) → q_effective q D → q_reducer G q σ := by + intro h_q_reduced h_q_effective v + have h_eff := h_q_reduced.1 + rcases (maxset_of_script G (-σ)) with ⟨S, ⟨w, h_w⟩, h_S⟩ + have q_S : q ∈ S := by + contrapose! h_q_effective with q_nin_S + rcases h_q_reduced.exists_lt_outdeg q_nin_S ⟨w, h_w⟩ with + ⟨v, v_in_S, h_debt⟩ + have dv_neg := lt_of_lt_of_le h_debt (h_S v v_in_S).2 + simp only [Pi.add_apply, map_neg, Pi.neg_apply, neg_neg, add_lt_iff_neg_right] at dv_neg + unfold q_effective; push Not; use v + suffices v ≠ q by simp only [ne_eq, this, not_false_eq_true, dv_neg, and_self] + contrapose! q_nin_S + rw [← q_nin_S]; exact v_in_S + have ineq : (-σ) v ≤ (-σ) q := ((h_S q q_S).1 v).1 + repeat rw [Pi.neg_apply] at ineq + linarith + +/-- Alternative description of $q$-reduced divisors: they are the maximal $q$-effective +divisors in their linear equivalence classes with respect to the $q$-reduction order. -/ +private lemma maximum_of_q_reduced (G : CFGraph) {q : G.V} {D : CFDiv G} : q_reduced G q D → ∀ D' : CFDiv G, linear_equiv G D D' → q_effective q D' → reduces_to G q D' D := by + intro h_q_reduced D' h_lequiv h_eff + unfold linear_equiv at h_lequiv + obtain ⟨σ, hσ⟩ := (principal_iff_eq_prin G (D'-D)).mp h_lequiv + have D_eq : D = D' + (prin G) (-σ) := by + rw [map_neg, ←hσ] + abel + have hred := q_reducer_of_add_princ_reduced G q D' (-σ) (by rwa [← D_eq]) h_eff + use (-σ), hred, D_eq + +/-- In a connected graph, every maximal $q$-effective divisor in the $q$-reduction partial +order is $q$-reduced. This fact is not needed for future results, but is included for context. -/ +private lemma q_reduced_of_maximal {G : CFGraph} (h_conn : graph_connected G) {q : G.V} {D : CFDiv G} (q_eff : q_effective q D) : (∀ D' : CFDiv G, linear_equiv G D D' → q_effective q D' → reduces_to G q D' D) → q_reduced G q D := by + intro h_maximal + unfold q_reduced + constructor + · -- Show q_effective holds + exact q_eff + · -- Show there is no nonempty legal set avoiding q + intro S q_nin_S h_S_nonempty + contrapose! h_maximal with h_reduces + let σ := indicator_script G S + have h_reducer : q_reducer G q σ := by + intro v + dsimp only [σ, indicator_script] + simp only [q_nin_S, ↓reduceIte] + by_cases h : v ∈ S <;> simp only [h, ↓reduceIte, Std.le_refl, zero_le_one] + use D + prin G σ + constructor + · -- Show linear equivalence + unfold linear_equiv; simp only [add_sub_cancel_left] + apply (principal_iff_eq_prin G (prin G σ)).mpr + use σ + constructor + · -- Show q_effective + rw [show σ = indicator_script G S from rfl, + ← set_firing_eq_add_prin_indicator_script] + exact q_effective_set_firing_of_legal_set G q_eff h_reduces + . -- Show ¬ reduces_to + by_contra! h_reduces + have h' : reduces_to G q D (D + prin G σ) := by use σ + have : D = D + prin G σ := by + exact reduces_to_antisymmetric h_conn q D (D + prin G σ) h' h_reduces + have prin_zero : prin G σ = 0 := by + calc + prin G σ = -D + (D + prin G σ) := by abel + _ = -D + D := by rw [← this] + _ = 0 := by abel + apply constant_script_of_zero_prin h_conn at prin_zero + let v := Classical.choose h_S_nonempty + let h_v := Classical.choose_spec h_S_nonempty + have v_S : v ∈ S := by exact h_v + specialize prin_zero v q + dsimp only [σ, indicator_script] at prin_zero + simp only [v_S, ↓reduceIte, q_nin_S, one_ne_zero] at prin_zero + +/-- The $q$-reduced representative of an effective divisor is effective. + +A $q$-reduced divisor is maximal in its class for the $q$-reduction order, so $E$ reduces +to $E'$; the number of chips at $q$ only increases along this order, and $E'$ is +nonnegative away from $q$ by definition. -/ +private lemma q_reduced_of_effective_is_effective (G : CFGraph) (q : G.V) (E E' : CFDiv G) : + effective E → linear_equiv G E E' → q_reduced G q E' → effective E' := by + intro h_eff h_equiv h_qred + -- E' is the maximum of its class, so E reduces to E'; chips at q only increase along + -- the order, and chips away from q are nonnegative since E' is q-effective. + have h_qeff : q_effective q E := fun v _ => h_eff v + have h_red : reduces_to G q E E' := + maximum_of_q_reduced G h_qred E h_equiv.symm h_qeff + intro v + by_cases hvq : v = q + · rw [hvq] + linarith [h_eff q, reduces_to_q_mono G q h_red] + · exact h_qred.1 v hvq + +/-- A winnable $q$-reduced divisor is effective. -/ +lemma effective_of_winnable_and_q_reduced (G : CFGraph) (q : G.V) (D : CFDiv G) : + winnable G D → q_reduced G q D → effective D := by + intro h_winnable h_qred + rcases h_winnable with ⟨E, h_eff_E, h_equiv⟩ + exact q_reduced_of_effective_is_effective G q E D h_eff_E h_equiv.symm h_qred + +/-- The $q$-reduced representative of a divisor class is unique. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 3.6, +part 2 (uniqueness). -/ +theorem q_reduced_unique (G : CFGraph) (q : G.V) (D₁ D₂ : CFDiv G) : + q_reduced G q D₁ ∧ q_reduced G q D₂ ∧ linear_equiv G D₁ D₂ → D₁ = D₂ := by + intro ⟨h_qred_1,h_qred_2,h_lequiv⟩ + unfold linear_equiv at h_lequiv + simp only [principal_iff_eq_prin] at h_lequiv + rcases h_lequiv with ⟨σ, h_D2_eq⟩ + have h_reducer_1 : q_reducer G q σ := by + apply q_reducer_of_add_princ_reduced G q D₁ σ + rw [← h_D2_eq] + simp only [add_sub_cancel] + exact h_qred_2 + exact h_qred_1.left + have h_reducer_2 : q_reducer G q (-σ) := by + apply q_reducer_of_add_princ_reduced G q D₂ (-σ) + rw [(prin G).map_neg, ← sub_eq_add_neg] + simp only [← h_D2_eq, sub_sub_cancel] + exact h_qred_1 + exact h_qred_2.left + have h_zero : prin G σ = 0 := + prin_eq_zero_of_two_sided_reducer G q σ h_reducer_1 h_reducer_2 + rw [h_zero] at h_D2_eq + apply sub_eq_zero.mp at h_D2_eq + rw [h_D2_eq] + + + +/-- A vertex is *active* if there exists a firing script that leaves the divisor effective +away from $q$, fires $q$ minimally, and fires this vertex strictly more than $q$. -/ +def active (G : CFGraph) (q : G.V) (D : CFDiv G) (v : G.V) : Prop := + ∃ σ : firing_script G, q_reducer G q σ ∧ q_effective q (D + prin G σ) ∧ σ q < σ v + +/-- A $q$-effective divisor with no active vertices is $q$-reduced. -/ +private lemma q_reduced_of_no_active (G :CFGraph) {q : G.V} {D : CFDiv G} (h_eff : q_effective q D) (h_no_active : ∀ v : G.V, ¬ active G q D v) : + q_reduced G q D := by + contrapose! h_no_active with h_not_q_reduced + dsimp only [q_reduced, ne_eq] at h_not_q_reduced + push Not at h_not_q_reduced + rcases h_not_q_reduced h_eff with ⟨S, q_nin_S, h_S_nonempty, h_outdeg⟩ + -- Construct a firing script that fires all vertices in S + let σ := indicator_script G S + have h_reducer : q_reducer G q σ := by + intro v + dsimp only [σ, indicator_script] + simp only [q_nin_S, ↓reduceIte] + by_cases h : v ∈ S + simp only [h, ↓reduceIte, zero_le_one]; simp only [h, ↓reduceIte, Std.le_refl] + use Classical.choose h_S_nonempty + let h := Classical.choose_spec h_S_nonempty + dsimp only [active] + use σ + refine ⟨h_reducer, ?_, ?_⟩ + · rw [show σ = indicator_script G S from rfl, + ← set_firing_eq_add_prin_indicator_script] + exact q_effective_set_firing_of_legal_set G h_eff h_outdeg + · simp only [σ, indicator_script, q_nin_S, ↓reduceIte, h, zero_lt_one] + +/-- The total number of chips held at active vertices of $D$. + +This quantity strictly decreases at each step of the $q$-reduction algorithm, providing +the termination measure for +`q_effective_to_q_reduced`. -/ +noncomputable def reduction_excess (G : CFGraph) (q : G.V) (D : CFDiv G) : ℤ := by + classical + exact (∑ v : G.V, if active G q D v then D v else 0) + + +/-- The reduction excess is nonnegative for $q$-effective divisors, since active vertices +satisfy $v \ne q$ and hence $D(v) \ge 0$. -/ +private lemma reduction_excess_nonneg (G : CFGraph) {q : G.V} {D : CFDiv G} (h_eff : q_effective q D) : + 0 ≤ reduction_excess G q D := by + dsimp only [reduction_excess] + apply Finset.sum_nonneg + intro v _ + by_cases h_active : active G q D v + · -- Case: v is active + simp only [h_active, ↓reduceIte] + apply h_eff + intro h_contra + rw [h_contra] at h_active + dsimp only [active] at h_active + rcases h_active with ⟨σ, h_reducer, h_eff', h_ineq⟩ + simp only [lt_self_iff_false] at h_ineq + · -- Case: v is not active + simp only [h_active, ↓reduceIte, Std.le_refl] + +/-- In a connected graph, every $q$-effective divisor is linearly equivalent to a $q$-reduced +divisor. + +The proof is by induction on `reduction_excess`. -/ +theorem q_effective_to_q_reduced {G : CFGraph} (h_conn : graph_connected G) {q : G.V} {D : CFDiv G} (h_eff : q_effective q D) : + ∃ E : CFDiv G, q_reduced G q E ∧ linear_equiv G D E := by + -- Use induction on reduction_excess + classical -- In order to filter using the undecidable "active" + let S := Finset.univ.filter (λ v : G.V => active G q D v) + have q_nin_S : q ∉ S := by + intro h_contra + dsimp only [S] at h_contra + simp only [Finset.mem_filter, mem_univ, true_and] at h_contra + dsimp only [active] at h_contra + rcases h_contra with ⟨σ, h_reducer, h_ineq⟩ + simp only [lt_self_iff_false, and_false] at h_ineq + by_cases h_S_empty : S = ∅ + · -- Case: No active vertices, so D is already q-reduced + use D + constructor + · -- q-reducedness + apply q_reduced_of_no_active G h_eff + intro v h_contra + have : v ∈ S := by + dsimp only [S] + simp only [Finset.mem_filter, mem_univ, h_contra, and_self] + rw [h_S_empty] at this + -- "this" is not v ∈ ∅, a contradiction + simp only [notMem_empty] at this + . -- Linear equivalence + exact linear_equiv.refl G D + · -- Case: There are active vertices. Choose one on the boundary. + have : ∃ v : G.V, active G q D v := by + contrapose! h_S_empty with h_no_active + dsimp only [S] + simp only [h_no_active, Finset.filter_false] + rcases this with ⟨v_active, h_v_active⟩ + have : ∃ (v q : G.V), v ∈ S ∧ q ∉ S := by + use v_active, q + simp only [q_nin_S, not_false_eq_true, and_true] + simp only [Finset.mem_filter, mem_univ, true_and, S] + exact h_v_active + have := h_conn S this + rcases this with ⟨v, v_in_S, w, w_nin_S, h_edge⟩ + -- Fire involving v to get a new divisor D' + simp only [Finset.mem_filter, mem_univ, true_and, S] at v_in_S + dsimp only [active] at v_in_S + rcases v_in_S with ⟨σ, h_reducer, h_eff_S, h_ineq⟩ + let D' := D + prin G (σ) + have D_equiv_D' : linear_equiv G D D' := by + unfold linear_equiv + have : D' - D = prin G σ := by + simp only [add_sub_cancel_left, D'] + rw [this] + apply (principal_iff_eq_prin G (prin G σ)).mpr ⟨σ,rfl⟩ + + -- Facts about D', needed for induction + have h_eff' : q_effective q D' := by + intro x x_ne_q + dsimp only [Pi.add_apply, D'] + exact h_eff_S x x_ne_q + + have h_active_shrinks (x : G.V): active G q D' x → active G q D x := by + intro h_active_D' + dsimp only [active] + rcases h_active_D' with ⟨σ', h_reducer', h_eff'', h_ineq'⟩ + use σ + σ' + constructor + · -- Show q_reducer + intro y + repeat rw [Pi.add_apply] + apply add_le_add (h_reducer y) (h_reducer' y) + constructor + · -- Show q_effective + intro z z_ne_q + dsimp only [D'] at h_eff'' + specialize h_eff'' z z_ne_q + rw [(prin G).map_add, ← add_assoc] + exact h_eff'' + · -- Show chips are fired from x + repeat rw [Pi.add_apply] + apply add_lt_add_of_le_of_lt + exact h_reducer x + exact h_ineq' + + have chips_to_inactive_per_edge (u x : G.V) : ¬ active G q D x → (σ u - σ x) * ↑(num_edges G x u) ≥ 0 := by + intro h_inactive_D + simp only [ge_iff_le] + apply mul_nonneg + · -- Show σ u - σ x ≥ 0 + have : σ x ≤ σ q := by + dsimp only [active] at h_inactive_D + push Not at h_inactive_D + specialize h_inactive_D σ + exact h_inactive_D h_reducer h_eff' + have : σ u ≥ σ q := by + specialize h_reducer u + linarith + linarith + · -- Show num_edges G x u ≥ 0 + simp only [Nat.cast_nonneg] + + have chips_to_inactive (x : G.V) : ¬ active G q D x → D x ≤ D' x := by + -- Goal: 0 ≤ ∑ (σ u - σ x) * num_edges G x u + intro h_inactive_D + simp only [Pi.add_apply, prin_apply, D'] + simp only [le_add_iff_nonneg_right] + apply Finset.sum_nonneg + intro u _ + exact chips_to_inactive_per_edge u x h_inactive_D + + have h_smaller : reduction_excess G q D' < reduction_excess G q D := by + dsimp only [reduction_excess] + repeat rw [Finset.sum_ite, Finset.sum_const_zero, add_zero] + -- First, pass to a sum over non-active vertices + have h (D : CFDiv G) : ∑ x ∈ Finset.filter (active G q D) univ, D x = deg D - ∑ x ∈ Finset.filter (fun v => ¬ active G q D v) univ, D x := by + dsimp only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] + rw [← Finset.sum_filter_add_sum_filter_not univ (fun v => active G q D v)] + simp only [add_sub_cancel_right] + rw [h D', h D] + have : deg D = deg D' := + linear_equiv_preserves_deg G D D' D_equiv_D' + rw [← this] + simp only [sub_lt_sub_iff_left, gt_iff_lt] + -- Write as a sum over all vertices in order to compare terms + have h (D : CFDiv G) : ∑ x ∈ Finset.filter (fun v => ¬ active G q D v) univ, D x = ∑ x : G.V, if ¬ active G q D x then D x else 0 := by + rw [Finset.sum_filter] + rw [h D', h D] + -- Now compare term-by-term + apply Finset.sum_lt_sum + -- Show each term is ≤ the corresponding term + intro x _ + by_cases h_active_D' : active G q D' x + · -- Case: x is active in D'. Then already active in D. + have h_active_D := h_active_shrinks x h_active_D' + simp only [h_active_D, not_true_eq_false, ↓reduceIte, h_active_D', Std.le_refl] + · -- Case: x is not active in D'. + simp only [ite_not, h_active_D', not_false_eq_true, ↓reduceIte] + by_cases h_active_D : active G q D x + · -- Subcase: x is active in D + simp only [h_active_D, ↓reduceIte] + -- Show 0 ≤ D' x + apply h_eff' x + intro h_contra + rw [h_contra] at h_active_D + dsimp only [S] at q_nin_S + simp only [Finset.mem_filter, mem_univ, true_and] at q_nin_S + contradiction + · -- Subcase: x is not active in D either + simp only [h_active_D, ↓reduceIte] + -- Show D x ≤ D' x + exact chips_to_inactive x h_active_D + -- Now, show that strict inequality holds for at least one term + use w + have h_inactive_D : ¬ active G q D w := by + dsimp only [S] at w_nin_S + simp only [Finset.mem_filter, mem_univ, true_and] at w_nin_S + exact w_nin_S + have h_active_D' : ¬ active G q D' w := by + contrapose! h_inactive_D with h_active_D' + exact (h_active_shrinks w) h_active_D' + simp only [mem_univ, h_inactive_D, not_false_eq_true, ↓reduceIte, h_active_D', true_and, + gt_iff_lt] + -- Show D w < D' w + simp only [Pi.add_apply, prin_apply, D'] + simp only [lt_add_iff_pos_right] + -- Goal: 0 < ∑ (σ u - σ w) * num_edges + apply Finset.sum_pos' + -- Show each term is nonnegative + intro u _ + exact chips_to_inactive_per_edge u w h_inactive_D + -- Show at least one term is positive + use v + simp only [mem_univ, true_and] + -- Goal: (σ v - σ w) * num_edges G w v > 0 + apply Int.mul_pos + · -- Show σ v - σ w > 0 + have : σ w ≤ σ q := by + dsimp only [active] at h_inactive_D + push Not at h_inactive_D + specialize h_inactive_D σ + exact h_inactive_D h_reducer h_eff' + linarith [this, h_ineq] + . -- Show num_edges G w v > 0 + rw [← num_edges_symmetric G v w] + simp only [Int.natCast_pos, h_edge] + have ih := q_effective_to_q_reduced h_conn h_eff' + rcases ih with ⟨E, h_q_reduced, h_lequiv⟩ + use E + constructor + · -- q-reducedness + exact h_q_reduced + · -- Linear equivalence + exact D_equiv_D'.trans h_lequiv +termination_by (reduction_excess G q D).toNat +decreasing_by + -- Some effort needed to deal with ℤ versus ℕ + rw [Int.toNat_lt] + simp only [Int.ofNat_toNat, lt_sup_iff] + dsimp only [D'] at h_smaller + left + exact h_smaller + exact reduction_excess_nonneg G h_eff' + +/-- Every divisor is linearly equivalent to some $q$-reduced divisor. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 3.6, +part 1 (existence). -/ +theorem exists_q_reduced_representative {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : + ∃ D' : CFDiv G, linear_equiv G D D' ∧ q_reduced G q D' := +by + rcases q_effective_exists h_conn q D with ⟨D_eff, h_eff, h_equiv⟩ + rcases q_effective_to_q_reduced h_conn h_eff with ⟨D_qred, h_qred, h_lequiv'⟩ + use D_qred + constructor + · -- Show linear equivalence + exact h_equiv.trans h_lequiv' + · -- Show q-reduced property + exact h_qred + +/-- Every divisor is linearly equivalent to exactly one $q$-reduced divisor. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 3.6 +(existence and uniqueness combined). -/ +lemma unique_q_reduced {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : + ∃! D' : CFDiv G, linear_equiv G D D' ∧ q_reduced G q D' := by + -- Prove existence and uniqueness separately + have h_exists : ∃ D' : CFDiv G, linear_equiv G D D' ∧ q_reduced G q D' := by + exact exists_q_reduced_representative h_conn q D + + -- Combine existence and uniqueness using the standard constructor + obtain ⟨D', hD'⟩ := h_exists + refine ExistsUnique.intro D' hD' (fun y hy => ?_) + exact q_reduced_unique G q y D' ⟨hy.2, hD'.2, hy.1.symm.trans hD'.1⟩ + +/-- A divisor is winnable if and only if its $q$-reduced representative is effective. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 3.7, +rephrased. -/ +theorem winnable_iff_q_reduced_effective {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : + winnable G D ↔ ∃ D' : CFDiv G, linear_equiv G D D' ∧ q_reduced G q D' ∧ effective D' := by + constructor + { -- Forward direction + intro h_win + rcases h_win with ⟨E, h_eff, h_equiv⟩ + rcases unique_q_reduced h_conn q D with ⟨D', h_D'⟩ + use D' + constructor + · exact h_D'.1.1 -- D is linearly equivalent to D' + constructor + · exact h_D'.1.2 -- D' is q-reduced + · -- D' is effective: E ~ D ~ D', and the q-reduced form of an effective divisor + -- is effective + exact q_reduced_of_effective_is_effective G q E D' h_eff + (h_equiv.symm.trans h_D'.1.1) h_D'.1.2 + } + { -- Reverse direction + intro h + rcases h with ⟨D', h_equiv, h_qred, h_eff⟩ + use D' + exact ⟨h_eff, h_equiv⟩ + } + +/-! +## The handshaking theorem + +The classical handshaking theorem for loopless multigraphs: the sum of all vertex degrees +is twice the number of edges (`sum_vertex_degree_eq_twice_card_edges`). The proof double +counts vertex-edge incidences, via the general counting lemma `sum_card_filter_eq_mul`. +These facts concern only the graph itself, not its divisor theory; they are collected here +for independent use. In this library, the handshaking theorem computes the degree of the +canonical divisor (see `degree_of_canonical_divisor` in `Orientation.lean`). +-/ + +/-- Rewrites a sum of filtered multiset cardinalities as a sum over mapped incidence counts. -/ +private lemma sum_filter_eq_map (G : CFGraph) (M : Multiset (G.V × G.V)) (crit : G.V → G.V × G.V → Prop) + [∀ v e, Decidable (crit v e)] : + ∑ v : G.V, Multiset.card (M.filter (crit v)) + = Multiset.sum (M.map (λ e => (Finset.univ.filter (λ v => (crit v e) )).card)) := by + -- Define P and g using Prop for clarity in the proof - Available throughout + let P : G.V → G.V × G.V → Prop := fun v e => crit v e + let g : G.V × G.V → ℕ := fun e => (Finset.univ.filter (P · e)).card + + -- Rewrite the goal using P and g for proof readability + suffices goal_rewritten : ∑ v : G.V, Multiset.card (M.filter (P v)) = Multiset.sum (M.map g) by + exact goal_rewritten -- The goal is now exactly the statement `goal_rewritten` + + -- Prove the rewritten goal by induction on the multiset G.edges + induction M using Multiset.induction_on with + | empty => + simp only [filter_zero, Multiset.card_zero, sum_const_zero, Multiset.map_zero, + sum_zero] -- Use _zero lemmas + | cons e_head s_tail ih_s_tail => + -- Rewrite RHS: sum(map(g, e_head::s_tail)) = g e_head + sum(map(g, s_tail)) + rw [Multiset.map_cons, Multiset.sum_cons] + + -- Rewrite LHS: ∑ v, card(filter(P v, e_head::s_tail)) + simp_rw [← Multiset.countP_eq_card_filter] + simp only [countP_cons] + rw [Finset.sum_add_distrib] + + -- Simplify the second sum (∑ v, ite (P v e_head) 1 0) to g e_head + have h_sum_ite_eq_card : ∑ v : G.V, ite (P v e_head) 1 0 = g e_head := by + rw [← Finset.card_filter] -- This completes the proof for h_sum_ite_eq_card + rw [h_sum_ite_eq_card] + + simp_rw [Multiset.countP_eq_card_filter] + rw [add_comm, ih_s_tail] + +/-- If every element of $M$ matches exactly $c$ vertices under `crit`, then summing the +filtered counts over all vertices gives $c$ times the size of $M$. -/ +lemma sum_card_filter_eq_mul (G : CFGraph) (M : Multiset (G.V × G.V)) + (crit : G.V → G.V × G.V → Prop) [∀ v e, Decidable (crit v e)] (c : ℕ) + (h_count : ∀ e ∈ M, (Finset.univ.filter (λ v => crit v e)).card = c) : + ∑ v : G.V, Multiset.card (M.filter (crit v)) = c * Multiset.card M := by + rw [sum_filter_eq_map G M crit, Multiset.map_congr rfl h_count, Multiset.map_const', + Multiset.sum_replicate, Nat.nsmul_eq_mul, Nat.mul_comm] + +/-- In a loopless graph, each edge has distinct endpoints. -/ +private lemma edge_endpoints_distinct (G : CFGraph) (e : G.V × G.V) (he : e ∈ G.edges) : + e.1 ≠ e.2 := by + by_contra eq_endpoints + rcases e with ⟨u,v⟩ + have : u = v := eq_endpoints + rw [this] at he + exact G.loopless v he + +/-- Each edge is incident to exactly two vertices. -/ +private lemma edge_incident_vertices_count (G : CFGraph) (e : G.V × G.V) (he : e ∈ G.edges) : + (Finset.univ.filter (λ v => e.1 = v ∨ e.2 = v)).card = 2 := by + rw [Finset.card_eq_two] + refine ⟨e.1, e.2, edge_endpoints_distinct G e he, ?_⟩ + ext v + simp only [eq_comm, Finset.mem_filter, mem_univ, true_and, mem_insert, Finset.mem_singleton] + +/-- Rewrites degree in terms of edge counts from each direction. -/ +private lemma degree_eq_total_flow {T : Type*} [DecidableEq T] [Fintype T] : + ∀ (S : Multiset (T × T)) (v : T), (∀ e ∈ S, e.1 ≠ e.2) → + ∑ u : T, Multiset.card (Multiset.filter (fun e ↦ e = (v, u) ∨ e = (u, v)) S) = + Multiset.card (S.filter (λ e => e.fst = v ∨ e.snd = v)) := by + -- Induct on the multiset S + intro S v h_loopless + induction S using Multiset.induction_on with + | empty => + simp only [filter_zero, Multiset.card_zero, sum_const_zero] + | cons e_head s_tail ih_s_tail => + -- Rewrite both sides using the head and tail + simp only [Multiset.filter_cons, card_add, sum_add_distrib] + rw [ih_s_tail] + -- Cancel the like terms in a + b = a + c + suffices h : + ∑ x : T, Multiset.card (if e_head = (v, x) ∨ e_head = (x, v) then {e_head} else 0) = + Multiset.card (if e_head.1 = v ∨ e_head.2 = v then {e_head} else 0) by + linarith + + rcases e_head with ⟨e, f⟩ + by_cases h_ev : e = v + · subst h_ev + have h_ef : e ≠ f := h_loopless (e, f) (by simp only [Multiset.mem_cons, true_or]) + have h_fv : f ≠ e := by simpa only [ne_eq, eq_comm] using h_ef + rw [Finset.sum_eq_single f] + · simp only [Prod.mk.injEq, true_or, ↓reduceIte, Multiset.card_singleton] + · intro x _ h_x + have h_fx : f ≠ x := fun h => h_x h.symm + simp only [Prod.mk.injEq, h_fx, and_false, h_fv, or_self, ↓reduceIte, Multiset.card_zero] + · simp only [mem_univ, not_true_eq_false, Prod.mk.injEq, true_or, ↓reduceIte, + Multiset.card_singleton, one_ne_zero, imp_self] + · by_cases h_fv : f = v + · subst h_fv + rw [Finset.sum_eq_single e] + · simp only [Prod.mk.injEq, or_true, ↓reduceIte, Multiset.card_singleton] + · intro x _ h_x + have h_ex : e ≠ x := fun h => h_x h.symm + simp only [Prod.mk.injEq, h_ev, false_and, h_ex, and_true, or_self, ↓reduceIte, + Multiset.card_zero] + · simp only [mem_univ, not_true_eq_false, Prod.mk.injEq, or_true, ↓reduceIte, + Multiset.card_singleton, one_ne_zero, imp_self] + · simp only [Prod.mk.injEq, h_ev, false_and, h_fv, and_false, or_self, ↓reduceIte, + Multiset.card_zero, sum_const_zero] + intro e + specialize h_loopless e + intro h_tail + apply h_loopless + simp only [Multiset.mem_cons, h_tail, or_true] + +-- Key lemma for handshaking theorem: Sum of edge counts equals incident edge count +private lemma sum_num_edges_eq_filter_count (G : CFGraph) (v : G.V) : + ∑ u, num_edges G v u = Multiset.card (G.edges.filter (λ e => e.fst = v ∨ e.snd = v)) := by + dsimp only [num_edges] + have h_loopless: ∀ e ∈ G.edges, e.1 ≠ e.2 := by + intro e he + exact edge_endpoints_distinct G e he + exact degree_eq_total_flow G.edges v (h_loopless) + +/-- +**Handshaking theorem:** In a loopless multigraph $G$, +the sum of the degrees of all vertices is twice the number of edges: + +$$ +\sum_{v \in V(G)} \deg(v) = 2 |E(G)|. +$$ +-/ +theorem sum_vertex_degree_eq_twice_card_edges (G : CFGraph) : + ∑ v, vertex_degree G v = 2 * ↑(Multiset.card G.edges) := by + calc ∑ v, vertex_degree G v + = ∑ v, ∑ u, (num_edges G v u : ℤ) := by simp_rw [vertex_degree] + _ = ∑ v, ↑(∑ u, num_edges G v u) := by simp_rw [← Nat.cast_sum] + _ = ∑ v, ↑(Multiset.card (G.edges.filter (λ e => e.fst = v ∨ e.snd = v))) := by simp_rw [sum_num_edges_eq_filter_count G] + _ = ↑(∑ v, Multiset.card (G.edges.filter (λ e => e.fst = v ∨ e.snd = v))) := by rw [← Nat.cast_sum] + _ = ↑(2 * Multiset.card G.edges) := by + -- Each edge is incident to exactly two vertices + rw [sum_card_filter_eq_mul G G.edges (λ v e => e.fst = v ∨ e.snd = v) 2 + (edge_incident_vertices_count G)] + _ = 2 * ↑(Multiset.card G.edges) := by rw [Nat.cast_mul, Nat.cast_two] diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean b/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean new file mode 100644 index 0000000000..f33725f55d --- /dev/null +++ b/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean @@ -0,0 +1,170 @@ +/- +Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger +-/ +import LeanPool.ChipFiring.ChipFiringWithLean.Basic +import Mathlib.LinearAlgebra.Matrix.Symmetric + + +open Multiset Finset + +inductive Person : Type + | A | B | C | E + deriving DecidableEq + +instance : Fintype Person where + elems := {Person.A, Person.B, Person.C, Person.E} + complete := by + intro x + cases x <;> simp only [mem_insert, reduceCtorEq, Finset.mem_singleton, or_false, or_true, + or_self] +instance : Nonempty Person := ⟨Person.A⟩ + +-- Example usage for `Person` in a loopless graph. +def exampleEdges : Multiset (Person × Person) := + Multiset.ofList [ + (Person.A, Person.B), + (Person.B, Person.C), + (Person.C, Person.E) + ] +private theorem loopless_example_edges : ∀ v, (v, v) ∉ exampleEdges := by + decide + +-- Example usage for `Person` in a graph with a loop. +def edgesWithLoop : Multiset (Person × Person) := + Multiset.ofList [ + (Person.A, Person.B), + (Person.A, Person.A), -- This is a loop + (Person.B, Person.C), + ] +private theorem loopless_test_edges_with_loop : ¬ (∀ v, (v, v) ∉ edgesWithLoop) := by decide + +def example_graph : CFGraph := { + V := Person, + edges := Multiset.ofList [ + (Person.A, Person.B), (Person.B, Person.C), + (Person.A, Person.C), (Person.A, Person.E), + (Person.A, Person.E), (Person.E, Person.C) + ], + loopless := by decide, +} + +def initial_wealth : CFDiv example_graph := + fun v => match v with + | Person.A => 2 + | Person.B => -3 + | Person.C => 4 + | Person.E => -1 + +-- Test vertex degrees +private theorem vertex_degree_A : vertex_degree example_graph Person.A = 4 := by rfl +private theorem vertex_degree_B : vertex_degree example_graph Person.B = 2 := by rfl +private theorem vertex_degree_C : vertex_degree example_graph Person.C = 3 := by rfl +private theorem vertex_degree_E : vertex_degree example_graph Person.E = 3 := by rfl + +-- Test edge counts +private theorem edge_count_AB : num_edges example_graph Person.A Person.B = 1 := by rfl +private theorem edge_count_BA : num_edges example_graph Person.B Person.A = 1 := by rfl +private theorem edge_count_BC : num_edges example_graph Person.B Person.C = 1 := by rfl +private theorem edge_count_CB : num_edges example_graph Person.C Person.B = 1 := by rfl +private theorem edge_count_AC : num_edges example_graph Person.A Person.C = 1 := by rfl +private theorem edge_count_CA : num_edges example_graph Person.C Person.A = 1 := by rfl +private theorem edge_count_AE : num_edges example_graph Person.A Person.E = 2 := by rfl +private theorem edge_count_EA : num_edges example_graph Person.E Person.A = 2 := by rfl +private theorem edge_count_EC : num_edges example_graph Person.E Person.C = 1 := by rfl +private theorem edge_count_CE : num_edges example_graph Person.C Person.E = 1 := by rfl +private theorem edge_count_BE : num_edges example_graph Person.B Person.E = 0 := by rfl +private theorem edge_count_EB : num_edges example_graph Person.E Person.B = 0 := by rfl + +-- Test No self-loops +private theorem edge_count_AA : num_edges example_graph Person.A Person.A = 0 := by rfl +private theorem edge_count_BB : num_edges example_graph Person.B Person.B = 0 := by rfl +private theorem edge_count_CC : num_edges example_graph Person.C Person.C = 0 := by rfl +private theorem edge_count_EE : num_edges example_graph Person.E Person.E = 0 := by rfl + +-- Test Charlie lending through an individual firing move +def after_charlie_lends := firing_move example_graph initial_wealth Person.C +private theorem charlie_wealth_after_lending : after_charlie_lends Person.C = 1 := by rfl +private theorem bob_wealth_after_charlie_lends : after_charlie_lends Person.B = -2 := by rfl + +-- Test set firing W₁ = {A,E,C} +def W₁ : Finset example_graph.V := {Person.A, Person.E, Person.C} +def after_W₁_firing := set_firing example_graph initial_wealth W₁ +private theorem alice_wealth_after_W₁ : after_W₁_firing Person.A = 1 := by rfl +private theorem bob_wealth_after_W₁ : after_W₁_firing Person.B = -1 := by rfl +private theorem charlie_wealth_after_W₁ : after_W₁_firing Person.C = 3 := by rfl +private theorem elise_wealth_after_W₁ : after_W₁_firing Person.E = -1 := by rfl + +-- Test set firing W₂ = {A,E,C} +def W₂ : Finset example_graph.V := W₁ +def after_W₂_firing := set_firing example_graph after_W₁_firing W₂ +private theorem alice_wealth_after_W₂ : after_W₂_firing Person.A = 0 := by rfl +private theorem bob_wealth_after_W₂ : after_W₂_firing Person.B = 1 := by rfl +private theorem charlie_wealth_after_W₂ : after_W₂_firing Person.C = 2 := by rfl +private theorem elise_wealth_after_W₂ : after_W₂_firing Person.E = -1 := by rfl + +-- Test set firing W₃ = {B,C} +def W₃ : Finset example_graph.V := {Person.B, Person.C} +def after_W₃_firing := set_firing example_graph after_W₂_firing W₃ +private theorem alice_wealth_after_W₃ : after_W₃_firing Person.A = 2 := by rfl +private theorem bob_wealth_after_W₃ : after_W₃_firing Person.B = 0 := by rfl +private theorem charlie_wealth_after_W₃ : after_W₃_firing Person.C = 0 := by rfl +private theorem elise_wealth_after_W₃ : after_W₃_firing Person.E = 0 := by rfl + +-- Test borrowing moves +def after_bob_borrows := borrowing_move example_graph initial_wealth Person.B +private theorem bob_wealth_after_borrowing : after_bob_borrows Person.B = -1 := by rfl +private theorem alice_wealth_after_bob_borrows : after_bob_borrows Person.A = 1 := by rfl +private theorem charlie_wealth_after_bob_borrows : after_bob_borrows Person.C = 3 := by rfl + +-- Test degree of divisors +private theorem initial_wealth_degree : deg initial_wealth = 2 := by rfl +private theorem after_W₁_degree : deg after_W₁_firing = 2 := by rfl +private theorem after_W₂_degree : deg after_W₂_firing = 2 := by rfl +private theorem after_W₃_degree : deg after_W₃_firing = 2 := by rfl + +-- Test effectiveness of divisors +private theorem initial_not_effective : ¬(effective initial_wealth) := by unfold effective; decide +private theorem after_W₃_firing_effective : effective after_W₃_firing := by unfold effective; decide + +-- Test Laplacian matrix values and symmetricity +def example_laplacian := laplacian_matrix example_graph +private theorem laplacian_diagonal_A : example_laplacian Person.A Person.A = 4 := by rfl +private theorem laplacian_diagonal_B : example_laplacian Person.B Person.B = 2 := by rfl +private theorem laplacian_diagonal_C : example_laplacian Person.C Person.C = 3 := by rfl +private theorem laplacian_diagonal_E : example_laplacian Person.E Person.E = 3 := by rfl +private theorem laplacian_off_diagonal_AB : example_laplacian Person.A Person.B = -1 := by rfl +private theorem laplacian_off_diagonal_AC : example_laplacian Person.A Person.C = -1 := by rfl +private theorem laplacian_off_diagonal_AE : example_laplacian Person.A Person.E = -2 := by rfl +private theorem laplacian_off_diagonal_BC : example_laplacian Person.B Person.C = -1 := by rfl +private theorem laplacian_off_diagonal_BE : example_laplacian Person.B Person.E = 0 := by rfl +private theorem laplacian_off_diagonal_CE : example_laplacian Person.C Person.E = -1 := by rfl +private theorem check_example_laplacian_symmetry : Matrix.IsSymm example_laplacian := by { + apply Matrix.IsSymm.ext + intro i j + cases i <;> cases j <;> rfl +} + +-- Test script firing through laplacians +def firing_script_example : firing_script example_graph := fun v => match v with + | Person.A => 0 + | Person.B => -1 + | Person.C => 1 + | Person.E => 0 +def res_div_post_lap_based_script_firing := apply_laplacian example_graph firing_script_example initial_wealth +private theorem lap_based_script_firing_preserves_degree : deg res_div_post_lap_based_script_firing = 2 := by rfl + +-- Test divisor that is not q-reduced with respect to Person.A +def non_q_reduced_example : CFDiv example_graph := fun v => match v with + | Person.A => 1 + | Person.B => -1 -- violates non-negativity condition for non-q vertices + | Person.C => 2 + | Person.E => 1 + +private theorem non_q_reduced_example_is_invalid : ¬q_reduced example_graph Person.A non_q_reduced_example := by { + rintro ⟨h1, _⟩ + have h1' : ∀ v : Person, v ≠ Person.A → non_q_reduced_example v ≥ 0 := h1 + simpa only [non_q_reduced_example, Int.reduceNeg, Int.neg_nonneg, Int.reduceLE] + using h1' Person.B (by decide) +} diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean new file mode 100644 index 0000000000..9ea8b05aef --- /dev/null +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean @@ -0,0 +1,773 @@ +/- +Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger +-/ +import LeanPool.ChipFiring.ChipFiringWithLean.Basic + + +open Multiset Finset + +/-! +## Configurations and superstable configurations + +Fix a vertex $q \in V(G)$. A *configuration* (`Config G q`) is a nonnegative integer assignment +to the vertices $V(G) \setminus \{q\}$, extended by zero at $q$. This corresponds to what +Corry-Perkinson call a *nonnegative configuration*; we use "configuration" +to mean "nonnegative configuration" throughout this library. + +A configuration $c$ is *superstable* if for every nonempty +$S \subseteq V(G) \setminus \{q\}$, some vertex in $S$ has fewer chips than its +out-degree to $V(G) \setminus S$. Equivalently, the associated divisor is $q$-reduced. +A *maximal superstable* configuration is one that is not dominated by any other +superstable configuration. + +The quantity `outdeg_S G S v` counts edges from $v$ to vertices outside $S$, and is the +relevant threshold for the superstability condition. +-/ + +/-- The set of vertices other than $q$: $\widetilde V = V(G) \setminus \{q\}$. -/ +abbrev Vtilde {G : CFGraph} (q : G.V) : Finset G.V := + univ.filter (λ v => v ≠ q) + +/-- A *configuration* on $G$ with respect to distinguished vertex $q$ is a nonnegative integer +assignment to all vertices, with the convention that $q$ holds zero chips. This is what +Corry-Perkinson call a *nonnegative configuration*. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 2.9. -/ +structure Config (G : CFGraph) (q : G.V) where + /-- The divisor recording the chip count at each vertex. -/ + (chips : CFDiv G) + /-- The distinguished vertex $q$ has no chips. -/ + (q_zero : chips q = 0) + /-- All chip counts are nonnegative. -/ + (non_negative : ∀ v : G.V, chips v ≥ 0) + +/-- The degree of a configuration is the sum of all values away from $q$: +$$ +\deg(c) = \sum_{v \in V(G)\setminus\{q\}} c(v). +$$ +Since $c(q)=0$, this is implemented as the degree of the underlying divisor. -/ +def config_degree {G : CFGraph} {q : G.V} (c : Config G q) : ℤ := + deg (c.chips) + +/-- Converts a configuration $c$ to a divisor of prescribed degree $d$ by placing +$d-\deg(c)$ chips at $q$. -/ +def toDiv {G : CFGraph} {q : G.V} (d : ℤ) (c : Config G q) : CFDiv G := + c.chips + (d - config_degree c) • (one_chip q) + +/-- Two configurations are equal if their chip counts agree at every vertex. -/ +@[ext] lemma Config.ext {q : G.V} {c₁ c₂ : Config G q} + (h : ∀ v : G.V, c₁.chips v = c₂.chips v) : c₁ = c₂ := by + obtain ⟨vd₁, _, _⟩ := c₁ + obtain ⟨vd₂, _, _⟩ := c₂ + simp only [mk.injEq] + exact funext h + +/-- Two configurations are equal if and only if their underlying divisors agree. -/ +lemma eq_config_iff_eq_chips {q : G.V} (c₁ c₂ : Config G q) : + c₁ = c₂ ↔ c₁.chips = c₂.chips := + ⟨fun h => by rw [h], fun h => Config.ext (congrFun h)⟩ + +/-- Two configurations are equal if and only if their images under `toDiv d` agree. -/ +lemma eq_config_iff_eq_div {q : G.V} (d : ℤ) (c₁ c₂ : Config G q) : c₁ = c₂ ↔ toDiv d c₁ = toDiv d c₂ := by + constructor + -- Forward direction is clear + intro h_eq + rw [h_eq] + -- Reverse direction takes more + intro h_eq + apply congrFun at h_eq + ext v + specialize h_eq v + dsimp only [toDiv, Pi.add_apply, Pi.smul_apply, Int.zsmul_eq_mul] at h_eq + by_cases h_v : q = v + . -- Case v = q + rw [← h_v] + rw [c₁.q_zero, c₂.q_zero] + . -- Case v ≠ q + simp only [ne_eq, h_v, not_false_eq_true, one_chip_apply_other, mul_zero, add_zero] at h_eq + exact h_eq + +/-- Converts a configuration $c$ to the $q$-effective divisor `toDiv d c`, +bundled with its proof of $q$-effectivity. -/ +def to_qed {q : G.V} (d : ℤ) (c : Config G q) : q_eff_div G q := + { + D := toDiv d c, + h_eff := by + intro v h_v + dsimp only [toDiv, Pi.add_apply, Pi.smul_apply, Int.zsmul_eq_mul] + simp only [ne_eq, h_v, not_false_eq_true, one_chip_apply_other', mul_zero, add_zero, + ge_iff_le] + exact c.non_negative v + } +/-- Converts a $q$-effective divisor to a configuration by zeroing out the chip count at $q$. -/ +def toConfig {q : G.V} (D : q_eff_div G q) : Config G q := { + chips := D.D - (D.D q) • (one_chip q) + q_zero := by + rw [Pi.sub_apply, Pi.smul_apply, smul_eq_mul] + dsimp only [one_chip] + simp only [↓reduceIte, mul_one, sub_self] + non_negative := by + intro v + by_cases h_v : v = q + · -- Case v = q + simp only [zsmul_eq_mul, h_v, Pi.sub_apply, Pi.mul_apply, Pi.intCast_apply, Int.cast_eq, + one_chip_apply_v, mul_one, sub_self, ge_iff_le, Std.le_refl] + . -- Case v ≠ q + simp only [zsmul_eq_mul, Pi.sub_apply, Pi.mul_apply, Pi.intCast_apply, Int.cast_eq, ne_eq, + h_v, not_false_eq_true, one_chip_apply_other', mul_zero, sub_zero, ge_iff_le] + exact D.h_eff v h_v +} + +/-- The degree of a $q$-effective divisor equals its value at $q$ plus the configuration degree. -/ +lemma config_degree_div_degree {q : G.V} (D : q_eff_div G q) : deg D.D = D.D q + config_degree (toConfig D) := by + simp only [config_degree, toConfig, map_sub, map_zsmul, deg_one_chip, smul_eq_mul, mul_one] + ring + +/-- Shifting the prescribed degree by $k$ adds $k$ chips at $q$. -/ +@[simp] lemma toDiv_config_degree_add {q : G.V} (c : Config G q) (k : ℤ) : + toDiv (config_degree c + k) c = c.chips + k • one_chip q := by + dsimp only [toDiv] + rw [show config_degree c + k - config_degree c = k by ring] + +/-- Prescribing degree $\deg(c)-1$ gives the divisor $c-q$. -/ +@[simp] private lemma toDiv_config_degree_sub_one {q : G.V} (c : Config G q) : + toDiv (config_degree c - 1) c = c.chips - one_chip q := by + rw [show config_degree c - 1 = config_degree c + (-1) by ring] + rw [toDiv_config_degree_add] + simp only [Int.reduceNeg, neg_smul, one_smul, sub_eq_add_neg] + +/-- The divisor $c-q$ has degree $\deg(c)-1$. -/ +@[simp] lemma deg_chips_sub_one_chip {q : G.V} (c : Config G q) : + deg (c.chips - one_chip q) = config_degree c - 1 := by + rw [map_sub, config_degree, deg_one_chip] + +/-- `toConfig` is a left inverse of `to_qed`: converting a configuration to a $q$-effective +divisor and back recovers the original configuration. -/ +private lemma config_of_div_of_config (c : Config G q) (d : ℤ) : + toConfig (to_qed d c) = c := by + rcases c with ⟨chips, q_zero, non_negative⟩ + dsimp only [to_qed, toConfig] + simp only [zsmul_eq_mul, Config.mk.injEq] + apply funext + intro v + by_cases h_v : v = q + . -- Case v = q + simp only [h_v, Pi.sub_apply, Pi.mul_apply, Pi.intCast_apply, Int.cast_eq, one_chip_apply_v, + mul_one, sub_self] + rw [q_zero] + . -- Case v ≠ q + dsimp only [toDiv, Pi.add_apply, Pi.smul_apply, one_chip, Int.zsmul_eq_mul, Pi.sub_apply, + Pi.mul_apply, Pi.intCast_apply, Int.cast_eq] + simp only [h_v, ↓reduceIte, mul_zero, add_zero, mul_one, sub_zero] + +/-- `to_qed` is a left inverse of `toConfig` at the correct degree: converting a $q$-effective +divisor to a configuration and back via `toDiv (deg D.D)` recovers the original divisor. -/ +lemma div_of_config_of_div (D : q_eff_div G q) : + toDiv (deg D.D) (toConfig D) = D.D := by + funext v + dsimp only [toDiv, Pi.add_apply, Pi.smul_apply, Int.zsmul_eq_mul] + by_cases h: v ∈ Vtilde q + . -- Case v ∈ Vtilde q + dsimp only [toConfig, Pi.sub_apply, Pi.smul_apply, Int.zsmul_eq_mul] + have : v ≠ q := by + intro h_eq_q + rw [h_eq_q] at h + simp only [Finset.mem_filter, mem_univ, ne_eq, not_true_eq_false, and_false] at h + simp only [ne_eq, this, not_false_eq_true, one_chip_apply_other', mul_zero, sub_zero, + zsmul_eq_mul, add_zero] + . -- Case v ∉ Vtilde q + have : v = q := by + contrapose! h + simp only [Finset.mem_filter, mem_univ, ne_eq, h, not_false_eq_true, and_self] + rw [this] + simp only [(toConfig D).q_zero, one_chip, ite_true, mul_one, zero_add] + linarith [config_degree_div_degree D] + +/-- A $q$-reduced divisor is recovered by converting to its canonical configuration and back. -/ +@[simp] lemma q_reduced_toDiv_toConfig (G : CFGraph) (q : G.V) (D : CFDiv G) + (h_qred : q_reduced G q D) : + toDiv (deg D) (toConfig ⟨D, h_qred.1⟩) = D := + div_of_config_of_div ⟨D, h_qred.1⟩ + +/-- A $q$-reduced divisor is its canonical configuration plus its chips at $q$. -/ +lemma q_reduced_eq_chips_add_q (G : CFGraph) (q : G.V) (D : CFDiv G) + (h_qred : q_reduced G q D) : + D = (toConfig ⟨D, h_qred.1⟩).chips + D q • one_chip q := by + let c : Config G q := toConfig ⟨D, h_qred.1⟩ + have h_deg : deg D = config_degree c + D q := by + simpa only [add_comm] using (config_degree_div_degree ⟨D, h_qred.1⟩) + calc + D = toDiv (deg D) c := by + exact (q_reduced_toDiv_toConfig G q D h_qred).symm + _ = toDiv (config_degree c + D q) c := by rw [h_deg] + _ = c.chips + D q • one_chip q := toDiv_config_degree_add c (D q) + +/-- If a $q$-reduced divisor has value $-1$ at $q$, it is exactly $c-q$ for its +canonical configuration $c$. -/ +lemma q_reduced_eq_chips_sub_one_chip (G : CFGraph) (q : G.V) (D : CFDiv G) + (h_qred : q_reduced G q D) (h_q : D q = -1) : + D = (toConfig ⟨D, h_qred.1⟩).chips - one_chip q := by + calc + D = (toConfig ⟨D, h_qred.1⟩).chips + D q • one_chip q := + q_reduced_eq_chips_add_q G q D h_qred + _ = (toConfig ⟨D, h_qred.1⟩).chips + (-1 : ℤ) • one_chip q := by rw [h_q] + _ = (toConfig ⟨D, h_qred.1⟩).chips - one_chip q := by + simp only [Int.reduceNeg, neg_smul, one_smul, sub_eq_add_neg] + +@[simp] private lemma eval_toDiv_q {q : G.V} (d : ℤ) (c : Config G q) : + toDiv d c q = d - config_degree c := by + dsimp only [toDiv, Pi.add_apply, Pi.smul_apply, Int.zsmul_eq_mul] + simp only [c.q_zero, one_chip_apply_v, mul_one, zero_add] + +@[simp] private lemma eval_toDiv_ne_q {q v : G.V} (d : ℤ) (c : Config G q) (h_v : v ≠ q) : + toDiv d c v = c.chips v := by + dsimp only [toDiv, Pi.add_apply, Pi.smul_apply, Int.zsmul_eq_mul] + simp only [ne_eq, h_v, not_false_eq_true, one_chip_apply_other', mul_zero, add_zero] + + +/-- The divisor `toDiv d c` is effective if and only if $d \ge \deg(c)$, i.e. there are +enough chips at $q$ to cover any debt. -/ +lemma config_eff {q : G.V} (d : ℤ) (c : Config G q) : effective (toDiv d c) ↔ d ≥ config_degree c := by + constructor + -- Effective implies d ≥ config_degree + intro h_eff + have h := h_eff q + rw [eval_toDiv_q] at h + linarith + -- d ≥ config_degree implies effective + intro h_deg v + by_cases h_v : v = q + · -- Case v = q + simp only [h_v, eval_toDiv_q, Int.sub_nonneg, h_deg] + · -- Case v ≠ q + simp only [ne_eq, h_v, not_false_eq_true, eval_toDiv_ne_q, ge_iff_le] + exact c.non_negative v + +instance : PartialOrder (Config G q) := { + le := λ c₁ c₂ => c₁.chips ≤ c₂.chips, + le_refl := by + intro _ + simp only [Std.le_refl], + le_trans := by + intro _ _ _ c1_le_c2 c2_le_c3 + exact le_trans c1_le_c2 c2_le_c3, + le_antisymm := by + intro c1 c2 h_le h_ge + have h_eq := le_antisymm h_le h_ge + exact (eq_config_iff_eq_chips c1 c2).mpr h_eq +} + +/-- The configuration degree is monotone: if $c \le c'$ pointwise, then +$\deg(c) \le \deg(c')$. -/ +lemma config_degree_mono {q : G.V} {c c' : Config G q} (h_le : c ≤ c') : + config_degree c ≤ config_degree c' := by + dsimp only [config_degree, deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] + exact Finset.sum_le_sum fun v _ => h_le v + +/-- Two configurations are equal if one is pointwise bounded above by the other and they have +the same degree. -/ +lemma config_eq_of_le_and_degree {q : G.V} {c1 c2 : Config G q} (h_le : c2 ≤ c1) + (h_deg : config_degree c1 = config_degree c2) : c1 = c2 := by + apply (eq_config_iff_eq_chips c1 c2).mpr + dsimp only [config_degree, deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] at h_deg + have h_le' : ∀ v : G.V, c2.chips v ≤ c1.chips v := by + intro v + exact h_le v + suffices ∀ v : G.V, c1.chips v = c2.chips v by + funext v + exact this v + contrapose! h_deg with h_ne + rcases h_ne with ⟨v, h_v_ne⟩ + have h_gt : c2.chips v < c1.chips v := by + specialize h_le' v + apply lt_of_le_of_ne h_le' + contrapose! h_v_ne + simp only [h_v_ne] + suffices config_degree c2 < config_degree c1 by + exact ne_of_gt this + dsimp only [config_degree, deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] + refine Finset.sum_lt_sum ?_ ?_ + · intro i _ + exact h_le' i + · use v + simp only [mem_univ, h_gt, and_self] + +/-- A configuration $c$ is *superstable* if for every nonempty +$S \subseteq V(G) \setminus \{q\}$, some vertex in $S$ has fewer chips than its +out-degree to $V(G) \setminus S$. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 3.12. -/ +def superstable (G : CFGraph) (q : G.V) (c : Config G q) : Prop := + ∀ S ⊆ Vtilde q, S.Nonempty → + ∃ v ∈ S, c.chips v < outdeg_S G S v + +/-- A configuration $c$ is superstable if and only if `toDiv d c` is $q$-reduced, +for any prescribed degree $d$. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Remark 3.14. -/ +lemma superstable_iff_q_reduced (G : CFGraph) (q : G.V) (d : ℤ) (c : Config G q) : + superstable G q c ↔ q_reduced G q (toDiv d c) := by + dsimp only [superstable, ne_eq] + constructor + -- Forward direction + intro h_superstable + constructor + -- Show c is nonnegative away from v + intro v hv_ne_q + dsimp only [toDiv, Pi.add_apply, Pi.smul_apply, Int.zsmul_eq_mul] + simp only [ne_eq, hv_ne_q, not_false_eq_true, one_chip_apply_other', mul_zero, add_zero, + ge_iff_le] + exact c.non_negative v + -- Show there is no nonempty legal set avoiding q + intro S hq hS_nonempty hlegal + have hS_subset : S ⊆ Vtilde q := by + intro v hv_in_S + simp only [Vtilde, Finset.mem_filter, mem_univ, true_and] + exact fun hvq => hq (hvq ▸ hv_in_S) + obtain ⟨v, hv_in_S, hv_outdeg⟩ := h_superstable S hS_subset hS_nonempty + have h_v_ne_q : v ≠ q := by + exact fun hvq => hq (hvq ▸ hv_in_S) + have hge := hlegal v hv_in_S + rw [eval_toDiv_ne_q d c h_v_ne_q] at hge + omega + -- Reverse direction + intro h_q_reduced S hS_subset hS_nonempty + have hq : q ∉ S := by + intro hq_in_S + have := hS_subset hq_in_S + simp only [Vtilde, Finset.mem_filter, mem_univ, ne_eq, not_true_eq_false, + and_false] at this + obtain ⟨v, hv_in_S, hv_outdeg⟩ := + h_q_reduced.exists_lt_outdeg hq hS_nonempty + use v + refine ⟨hv_in_S, ?_⟩ + have h_v_neq_q : v ≠ q := fun hvq => hq (hvq ▸ hv_in_S) + rw [eval_toDiv_ne_q d c h_v_neq_q] at hv_outdeg + exact hv_outdeg + +/-- The canonical configuration of a $q$-reduced divisor is superstable. -/ +lemma q_reduced_toConfig_superstable (G : CFGraph) (q : G.V) (D : CFDiv G) + (h_qred : q_reduced G q D) : + superstable G q (toConfig ⟨D, h_qred.1⟩) := by + rw [superstable_iff_q_reduced G q (deg D) (toConfig ⟨D, h_qred.1⟩)] + simpa only [q_reduced_toDiv_toConfig G q D h_qred] using h_qred + +/-- A divisor is $q$-reduced if and only if it corresponds to a superstable configuration with + respect to $q$. -/ +lemma q_reduced_superstable_correspondence (G : CFGraph) (q : G.V) (D : CFDiv G) : + q_reduced G q D ↔ ∃ c : Config G q, superstable G q c ∧ + D = toDiv (deg D) c := by + constructor + . -- Forward direction (q_reduced → ∃ c, superstable ∧ D = c - δ_q) + intro h_qred + refine ⟨toConfig ⟨D, h_qred.1⟩, q_reduced_toConfig_superstable G q D h_qred, ?_⟩ + exact (q_reduced_toDiv_toConfig G q D h_qred).symm + -- Backward direction (∃ c, superstable ∧ D = c - δ_q → q_reduced) + · intro h_exists + rcases h_exists with ⟨c, h_super, D_eq⟩ + rw [D_eq] + rw [← superstable_iff_q_reduced G q (deg D) c] + exact h_super + + +/-- A maximal superstable configuration is not strictly dominated by any other superstable +configuration. -/ +def maximal_superstable (G : CFGraph) {q : G.V} (c : Config G q) : Prop := + superstable G q c ∧ ∀ c' : Config G q, superstable G q c' → c ≤ c' → c' = c + + +/-- Subtracting a chip at $q$ from a superstable configuration gives an unwinnable +divisor. -/ +lemma superstable_sub_chip_unwinnable {G : CFGraph} (q : G.V) (c : Config G q) : + superstable G q c → + ¬winnable G (c.chips - one_chip q) := by + intro h_superstable + let D := c.chips - one_chip q + have h_red : q_reduced G q D := by + apply (q_reduced_superstable_correspondence G q D).mpr + refine ⟨c, h_superstable, ?_⟩ + -- Prove D = c - δ_q + have h_deg_D : deg D = config_degree c - 1 := by + dsimp only [D] + exact deg_chips_sub_one_chip (c := c) + rw [h_deg_D] + dsimp only [D] + exact (toDiv_config_degree_sub_one (c := c)).symm + -- A winnable q-reduced divisor is effective, but D has -1 chips at q. + intro h_winnable + have h_nonneg_q := effective_of_winnable_and_q_reduced G q D h_winnable h_red q + dsimp only [Pi.sub_apply, D] at h_nonneg_q + simp only [c.q_zero, one_chip_apply_v, zero_sub, Int.reduceNeg, Int.neg_nonneg, + Int.reduceLE] at h_nonneg_q + + +/-! +## Burn lists and Dhar's burning algorithm + +A *burn list* for a configuration $c$ is an ordered list of distinct vertices ending at $q$. +The list is stored in reverse burn order: starting from $[q]$, each new burnable vertex is +prepended to the list. A vertex is burnable when its number of chips is less than its +out-degree into the vertices that have already burned. The key property is that a +configuration is superstable if and only if a complete burn list, one containing all +vertices, exists (`superstable_burn_list`). + +The `burn_flow` function extracts an orientation from a burn list by directing each edge +toward the vertex that appears earlier in the list. This is used to construct the bijection +between maximal superstable configurations and acyclic orientations with unique source $q$ +(see `Orientation.lean`). +-/ + + +/-- A burn list for a configuration $c$ is a list $[v_1,v_2,\ldots,v_n,q]$ of distinct +vertices ending at $q$, stored in reverse burn order. + +For each $i$, let +$$ +S_i = V(G) \setminus \{v_{i+1},\ldots,v_n,q\}. +$$ +Then $v_i \in S_i$, and the out-degree of $v_i$ with respect to $S_i$, equivalently the +number of edges from $v_i$ to the later vertices $\{v_{i+1},\ldots,v_n,q\}$, is greater +than the number of chips at $v_i$. -/ +def is_burn_list (G : CFGraph) {q : G.V} (c : Config G q) (L : List G.V) : Prop := + match L with + | [] => False + | [x] => (x = q) + | v :: w :: rest => + outdeg_S G (univ \ (w :: rest).toFinset) v > c.chips v + -- v isn't in the set made out of w :: rest + ∧ ¬ (w :: rest).contains v + ∧ is_burn_list G c (w :: rest) + +/-- Every burn list contains $q$, since the base case of a burn list is $[q]$. -/ +private lemma burn_list_contains_q (G : CFGraph) {q : G.V} (c : Config G q) (L : List G.V) (h_bl : is_burn_list G c L) : + L.contains q := by + induction L with + | nil => + dsimp only [is_burn_list] at h_bl + | cons v rest ih => + cases rest with + | nil => + dsimp only [is_burn_list] at h_bl + rw [h_bl] + simp only [List.contains_eq_mem, List.mem_cons, List.not_mem_nil, or_false, decide_true] + | cons w rest' => + dsimp only [is_burn_list] at h_bl + rcases h_bl with ⟨h_outdeg, h_not_in_rest, h_rest_burn_list⟩ + specialize ih h_rest_burn_list + simp only [List.contains_eq_mem, List.mem_cons, Bool.decide_or, Bool.or_eq_true, + decide_eq_true_eq] + simp only [List.contains_eq_mem, List.mem_cons, Bool.decide_or, Bool.or_eq_true, + decide_eq_true_eq] at ih + simp only [ih, or_true] + +/-- If $c$ is superstable and a burn list $L$ does not yet contain all vertices, it can be +extended by prepending a new vertex. This corresponds to the next edge burning in Dhar's +burning algorithm; superstability implies that the entire graph will burn. -/ +private lemma extend_burn_list (G : CFGraph) {q : G.V} (c : Config G q) (h_ss : superstable G q c) (L : List G.V) : is_burn_list G c L → (∃ v : G.V, ¬ L.contains v) → (∃ w : G.V, w ∉ L.toFinset ∧ is_burn_list G c (w :: L)) := by + intro h_bl h_exists_v + let S := univ \ L.toFinset + have h_S_ne : S.Nonempty := by + rcases h_exists_v with ⟨v, h_v_not_in_L⟩ + use v + dsimp only [S] + simp only [mem_sdiff, mem_univ, List.mem_toFinset, true_and] + contrapose! h_v_not_in_L with h_raa + simp only [List.contains_eq_mem, h_raa, decide_true] + have h_S_Vtilde : S ⊆ Vtilde q := by + intro v h_v_in_S + dsimp only [Vtilde, ne_eq] + simp only [Finset.mem_filter, mem_univ, true_and] + contrapose! h_v_in_S with h_eq + rw [h_eq] + dsimp only [S] + simp only [mem_sdiff, mem_univ, List.mem_toFinset, true_and, Decidable.not_not] + -- Goal is not: q ∈ L + have := burn_list_contains_q G c L h_bl + simp only [List.contains_eq_mem, decide_eq_true_eq] at this + exact this + specialize h_ss S h_S_Vtilde h_S_ne + rcases h_ss with ⟨v, hv_in_S, hv_outdeg⟩ + use v + dsimp only [S] at hv_outdeg hv_in_S -- To get L to simplify after matching + match L with + | [] => + exfalso + dsimp only [is_burn_list] at h_bl + | h :: t => + dsimp only [is_burn_list] + -- Unpack all the conjunctions and use hypotheses one by one + constructor + . simp only [List.toFinset_cons, mem_sdiff, mem_univ, mem_insert, List.mem_toFinset, not_or, + true_and] at hv_in_S + simp only [List.toFinset_cons, mem_insert, List.mem_toFinset, not_or] + exact hv_in_S + constructor + . exact hv_outdeg + constructor + simp only [List.contains_eq_mem, List.mem_cons, Bool.decide_or, Bool.or_eq_true, + decide_eq_true_eq, not_or] + constructor + intro h + rw [h] at hv_in_S + simp only [List.toFinset_cons, mem_sdiff, mem_univ, mem_insert, List.mem_toFinset, true_or, + not_true_eq_false, and_false] at hv_in_S + simp only [List.toFinset_cons, mem_sdiff, mem_univ, mem_insert, List.mem_toFinset, not_or, + true_and] at hv_in_S + exact hv_in_S.2 + exact h_bl + +/-- A bundled burn list: a list $L$ of vertices together with a proof that it satisfies the +`is_burn_list` conditions for configuration $c$. -/ +structure burn_list (G : CFGraph) {q : G.V} (c : Config G q) where + (list : List G.V) + (h_burn_list : is_burn_list G c list) + +/-- For each $n < |V(G)|$, there exists a burn list of size $n+1$. This is the inductive step for +`superstable_burn_list`. -/ +private lemma burn_list_helper (G : CFGraph) {q : G.V} (c : Config G q) (h_ss : superstable G q c) (n : ℕ) : (n < Finset.card (univ : Finset G.V))→ ∃ (L : List G.V), L.toFinset.card = n+1 ∧ is_burn_list G c L := by + intro h_n_lt_card_V + induction n with + | zero => + use [q] + constructor + simp only [List.toFinset_cons, List.toFinset_nil, insert_empty_eq, Finset.card_singleton, + zero_add] + dsimp only [is_burn_list] + | succ n ih => + have ih_L : n < (univ : Finset G.V).card := by + linarith + apply ih at ih_L + rcases ih_L with ⟨L, h_L_length, h_L_burn_list⟩ + have h_exists_v : ∃ v : G.V, ¬ L.contains v := by + have h_card_L_le : L.toFinset.card < (univ : Finset G.V).card := by + rw [← h_L_length] at h_n_lt_card_V + linarith + obtain ⟨v, -, h_v_not_in_L⟩ := Finset.exists_mem_notMem_of_card_lt_card h_card_L_le + exact ⟨v, by simpa only [List.contains_eq_mem, decide_eq_true_eq, List.mem_toFinset] + using h_v_not_in_L⟩ + have := extend_burn_list G c h_ss L h_L_burn_list h_exists_v + rcases this with ⟨w, h_w_burn_list⟩ + use w :: L + constructor + . -- Show cardinality is n+2 + rw [List.toFinset_cons] + rw [card_insert_eq_ite] + -- Need: w ∉ L.toFinset + simp only [h_w_burn_list.1, ↓reduceIte, Nat.add_right_cancel_iff] + rw [h_L_length] + . -- Show the tail is a burn list + exact h_w_burn_list.2 + +/-- A superstable configuration admits a complete burn list containing every vertex of $G$. +This is the key output of Dhar's burning algorithm: in a superstable configuration, the +whole graph burns. -/ +lemma superstable_burn_list (G : CFGraph) {q : G.V} (c : Config G q) (h_ss : superstable G q c) : ∃ L : burn_list G c, ∀ v : G.V, v ∈ L.list := by + have h_card_V : (univ : Finset G.V).card ≥ 1 := by + have h_nonempty : Nonempty G.V := by infer_instance + have h_card_pos : (univ : Finset G.V).card > 0 := Fintype.card_pos_iff.mpr h_nonempty + linarith + have : (univ : Finset G.V).card - 1 < (univ : Finset G.V).card := by + simp only [card_univ, tsub_lt_self_iff, Order.lt_one_iff, and_true] + -- Now show `Fintype.card G.V > 0`, so that the subtraction makes sense. + apply Fintype.card_pos_iff.mpr + infer_instance + have h_burn_list := burn_list_helper G c h_ss ((univ : Finset G.V).card - 1) this + rcases h_burn_list with ⟨L, h_L_length, h_L_burn_list⟩ + have h_L_card : L.toFinset.card = (univ : Finset G.V).card := by + simp only [h_L_length, card_univ] + apply Nat.sub_add_cancel + exact h_card_V + use burn_list.mk L h_L_burn_list + have h_toFinset_eq : L.toFinset = (univ : Finset G.V) := by + refine Finset.eq_of_subset_of_card_le (Finset.subset_univ _) ?_ + simp only [card_univ, h_L_card, Std.le_refl] + intro v + have : v ∈ L.toFinset := by simp only [h_toFinset_eq, mem_univ] + simpa only [List.mem_toFinset] using this + +-- The following lemmas establish the necessary properties of the orientation to be defined +-- from the burn order. + +/-- The orientation induced by a burn list: for each edge $(u,v)$, direct it from $u$ to $v$ +(i.e. assign nonzero flow) if $u$ appears in the list and $v$ appears before $u$. In other +words, the orientation indicates the direction of the spreading fire in Dhar's burning +algorithm. -/ +def burn_flow {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) : (G.V × G.V) → ℕ := + λ e => if (e.1 ∈ L.list) ∧ (L.list.idxOf e.2 < L.list.idxOf e.1) then num_edges G e.1 e.2 else 0 + +/-- The `burn_flow` of a complete burn list is a valid orientation: for every edge +$\{u,v\}$, exactly `num_edges G u v` units of flow are directed in one of the two +directions. -/ +lemma burn_flow_reverse {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (h_full : ∀ v : G.V, v ∈ L.list) : ∀ (u v : G.V), (burn_flow L ⟨u, v⟩) + (burn_flow L ⟨v, u⟩) = num_edges G u v := by + intro u v + dsimp only [burn_flow] + by_cases h_uv : L.list.idxOf v < L.list.idxOf u + . -- Case: indexOf v < indexOf u + simp only [h_full u, h_uv, and_self, ↓reduceIte, h_full v, true_and, Nat.add_eq_left, + ite_eq_right_iff] + intro h + linarith + . -- Case: indexOf v ≥ indexOf u + by_cases h_eq : L.list.idxOf u = L.list.idxOf v + . -- Subcase: indexOf u < indexOf v + simp only [h_eq, lt_self_iff_false, and_false, ↓reduceIte, add_zero] + have : u = v := (List.idxOf_inj (h_full u)).mp h_eq + rw [this, num_edges_self_zero G v] + . -- Subcase: indexOf u > indexOf v + have h_uv' : L.list.idxOf u < L.list.idxOf v := by + simp only [not_lt] at h_uv h_eq + exact lt_of_le_of_ne h_uv h_eq + simp only [h_uv, and_false, ↓reduceIte, h_full v, h_uv', and_self, zero_add] + exact num_edges_symmetric G v u + +/-- The `burn_flow` of a complete burn list is directed: for every pair $(u,v)$, flow goes +in at most one direction. -/ +lemma burn_flow_directed {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (h_full : ∀ v : G.V, v ∈ L.list) : ∀ (u v : G.V), burn_flow L ⟨u,v⟩ = 0 ∨ burn_flow L ⟨v,u⟩ = 0 := by + intro u v + dsimp only [burn_flow] + by_cases h_uv : L.list.idxOf v < L.list.idxOf u + . -- Case: indexOf v < indexOf u + simp only [h_full u, h_uv, and_self, ↓reduceIte, h_full v, true_and, ite_eq_right_iff] + right + intro h + linarith + . -- Case: indexOf v ≥ indexOf u + by_cases h_eq : L.list.idxOf u = L.list.idxOf v + . -- Subcase: indexOf u = indexOf v + simp only [h_eq, lt_self_iff_false, and_false, ↓reduceIte, or_self] + . -- Subcase: indexOf u > indexOf v + have h_uv' : L.list.idxOf u < L.list.idxOf v := by + simp only [not_lt] at h_uv h_eq + exact lt_of_le_of_ne h_uv h_eq + simp only [h_uv, and_false, ↓reduceIte, h_full v, h_uv', and_self, true_or] + +/-- For any vertex $v \ne q$ in a burn list, the in-flow into $v$ exceeds the number of +chips at $v$. This is the key inequality used to construct an acyclic orientation from a +superstable configuration. -/ +lemma burnin_degree {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (v : G.V) (h_pres : v ∈ L.list) (h_ne : v ≠ q): ∑ (w : G.V), burn_flow L ⟨w,v⟩ > c.chips v := by + let h_bl := L.h_burn_list + cases h: L.list with + | nil => + rw [h] at h_bl + dsimp only [is_burn_list] at h_bl + | cons x rest => + cases h' : rest with + | nil => + rw [h'] at h + rw [h] at h_bl + dsimp only [is_burn_list] at h_bl + -- So x = q + simp only [h, List.mem_cons, List.not_mem_nil, or_false] at h_pres + rw [h_pres, ← h_bl] at h_ne + contradiction + | cons y rest' => + rw [h'] at h + rw [h] at h_bl + dsimp only [is_burn_list] at h_bl + -- Need to analyze the position of v in the list + by_cases h_vx : v = x + . -- Case: v = x + rw [← h_vx] at h_bl + suffices ∑ (w : G.V), burn_flow L ⟨w,v⟩ ≥ outdeg_S G (univ \ (y :: rest').toFinset) v by + linarith [this, h_bl.1] + dsimp only [burn_flow] + have ind_v : L.list.idxOf v = 0 := by + rw [h_vx,h] + simp only [List.idxOf_cons_self] + simp only [ind_v] + have h_ineq := h_bl.1 + have h_above : ∀ (x : G.V), x ∈ L.list ∧ 0 < List.idxOf x L.list ↔ x ∈ rest := by + intro w + rw [← h'] at h + rw [h] + simp only [List.mem_cons] + have : 0 < List.idxOf w (x :: rest) ↔ 0 ≠ List.idxOf w (x :: rest) := by + constructor + . intro h_pos h_eq + rw [h_eq] at h_pos + linarith + . intro h_neq + simp only [ne_eq] at h_neq + apply Nat.zero_lt_of_ne_zero + contrapose! h_neq with h_eq_zero + rw [h_eq_zero] + rw [this] + have : 0 ≠ List.idxOf w (x :: rest) ↔ w ≠ x := by + constructor + . intro h_neq + contrapose! h_neq with h_eq + rw [h_eq] + simp only [List.idxOf_cons_self] + . intro h_neq + rw [List.idxOf_cons_ne _ (Ne.symm h_neq)] + simp only [Nat.succ_eq_add_one, ne_eq, Nat.right_eq_add, Nat.add_eq_zero_iff, + one_ne_zero, and_false, not_false_eq_true] + rw [this] + constructor + . -- Forward direction + intro h_w + by_contra! + simp only [this, or_false, ne_eq, and_not_self] at h_w + . -- Reverse direction + intro h_w_in_rest + simp only [h_w_in_rest, or_true, ne_eq, true_and] + by_contra! + rw [this] at h_w_in_rest + have := h_bl.2.1 + rw [h_vx] at this + rw [← h'] at this + absurd this + simp only [List.contains_eq_mem, h_w_in_rest, decide_true] + simp only [h_above] + dsimp only [outdeg_S] + rw [← h'] + rw [Finset.sum_ite, Finset.sum_const_zero, add_zero] + simp only [Nat.cast_sum, sdiff_sdiff_right_self, subset_univ, inf_of_le_right, ge_iff_le] + have : Finset.filter (Membership.mem rest) univ = rest.toFinset := by + ext w + simp only [Finset.mem_filter, mem_univ, true_and, List.mem_toFinset] + rw [this] + apply sum_le_sum + intro i _ + rw [num_edges_symmetric G i v] + . -- Case: v ≠ x + let L' := burn_list.mk (y :: rest') (h_bl.2.2) + have h_v_in_L' : v ∈ L'.list := by + dsimp only [L'] + rw [← h'] + rw [← h'] at h + rw [h] at h_pres + simp only [List.mem_cons, h_vx, false_or] at h_pres + exact h_pres + have h_step : ∀ (w : G.V), burn_flow L ⟨w,v⟩ = burn_flow L' ⟨w,v⟩ := by + have h_x_nin_rest: x ∉ rest := by + have := L.h_burn_list + rw [h] at this + have := this.2.1 + rw [h'] + simp only [List.contains_eq_mem, List.mem_cons, Bool.decide_or, Bool.or_eq_true, + decide_eq_true_eq, not_or] at this + simp only [List.mem_cons, this, or_self, not_false_eq_true] + intro w + dsimp only [burn_flow, L'] + rw [h] + rw [List.idxOf_cons_ne _ (Ne.symm h_vx)] + by_cases h_wx : w = x + . -- Subcase: w = x + rw [h_wx] + have h0 : (x :: y :: rest').idxOf x = 0 := List.idxOf_cons_self + rw [h0, ite_eq_right (fun ⟨_, h⟩ => Nat.not_lt_zero _ h), + ite_eq_right (fun ⟨h_mem, _⟩ => (h' ▸ h_x_nin_rest) h_mem)] + . -- Subcase: w ≠ x + simp only [List.mem_cons, h_wx, false_or] + rw [List.idxOf_cons_ne (y :: rest') (Ne.symm h_wx)] + simp only [Nat.succ_lt_succ_iff] + simp only [h_step] + have h_ind := burnin_degree L' v h_v_in_L' h_ne + exact h_ind +termination_by L.list.length +decreasing_by + rw [h,h'] + simp only [List.length_cons, lt_add_iff_pos_right, Order.lt_one_iff] diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean new file mode 100644 index 0000000000..6314f8e9eb --- /dev/null +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean @@ -0,0 +1,1259 @@ +/- +Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger +-/ +import LeanPool.ChipFiring.ChipFiringWithLean.Config +import Mathlib.Data.DFinsupp.Multiset + + +open Multiset Finset + +/-! +## Orientations of chip-firing graphs + +This file defines orientations of chip-firing graphs and establishes their relationship to +divisors, configurations, and the Riemann-Roch theorem. + +An *orientation* (`CFOrientation G`) assigns a direction to each edge of $G$. The key +objects are: +- `indeg G O v`: the in-degree of vertex $v$ under orientation $\mathcal{O}$. +- `ordiv G O`: the divisor $D(\mathcal{O})$ assigning $\mathrm{indeg}(v) - 1$ to each vertex. +- `orientation_to_config G O q`: the configuration $c(\mathcal{O})$ for acyclic orientations + with unique source $q$. + +The main results are: +- **Theorem 4.8**: There is a bijection between acyclic orientations + with unique source $q$ and maximal superstable configurations + (`orientation_superstable_bijection`). +- The divisor of an acyclic orientation is unwinnable (`ordiv_unwinnable`). +- The canonical divisor $K_G = D(\mathcal{O}) + D(\overline{\mathcal{O}})$ where + $\overline{\mathcal{O}}$ is the reverse orientation (`divisor_reverse_orientation`). +- The degree of the canonical divisor is $2g-2$ (`degree_of_canonical_divisor`). + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 4.8. +-/ + +/-- An *orientation* of $G$ assigns a direction to each edge. + +The field `directed_edges` is a multiset of directed pairs. The `count_preserving` field +ensures that the total flow between $v$ and $w$ equals the edge multiplicity, and +-/ +structure CFOrientation (G : CFGraph) where + /-- The multiset of directed edges in the orientation. -/ + directed_edges : Multiset (G.V × G.V) + /-- The total directed flow between two vertices preserves the graph's edge multiplicity. -/ + count_preserving : ∀ v w, + num_edges G v w = + Multiset.count (v, w) directed_edges + Multiset.count (w, v) directed_edges + +/-- The flow from $u$ to $v$ under an orientation $\mathcal{O}$ is the multiplicity of +the directed edge $(u,v)$. -/ +abbrev flow {G: CFGraph} (O : CFOrientation G) (u v : G.V) : ℕ := + Multiset.count (u,v) O.directed_edges + +/-- The total flow on an undirected edge equals its multiplicity. -/ +private lemma opp_flow {G : CFGraph} (O : CFOrientation G) (u v : G.V) : + flow O u v + flow O v u= (num_edges G u v) := by + rw[O.count_preserving u v] + +/-- Two orientations are equal if and only if they assign the same flow to every directed pair. -/ +private lemma eq_orient {G : CFGraph} (O1 O2 : CFOrientation G) : O1 = O2 ↔ ∀ (u v : G.V), flow O1 u v = flow O2 u v := by + constructor + · intro h_eq u v + rw [h_eq] + -- Converse + · intro h_flow_eq + have h_directed_edges_eq : O1.directed_edges = O2.directed_edges := by + apply Multiset.ext.mpr + intro ⟨u,v⟩ + specialize h_flow_eq u v + exact h_flow_eq + cases O1 + cases O2 + cases h_directed_edges_eq + rfl + +/-- Rewrites a double sum over a finite type as a sum over ordered pairs. -/ +private lemma double_sum {T : Type*} [DecidableEq T] [Fintype T] (f : T × T → ℕ) : + ∑ (u : T), ∑ (v : T), f ⟨u, v⟩ = ∑ (e : T × T), f e := by + rw [← Finset.sum_product] + simp only [univ_product_univ] + +/-- The multiset of directed edges in an orientation has the same cardinality as the +underlying multiset of graph edges. -/ +private lemma card_directed_edges_eq_card_edges {G : CFGraph} (O : CFOrientation G) : Multiset.card O.directed_edges = Multiset.card G.edges := by + have hms (M : Multiset (G.V × G.V)): ∀ e ∈ M, e ∈ univ := by + intro e _ + exact mem_univ e + + let f (u v : G.V) := flow O u v + let g (u v : G.V) := Multiset.count ⟨u,v⟩ G.edges + have h_uv (u v : G.V) : f u v + f v u = g u v + g v u := by + have h := O.count_preserving u v + dsimp only [flow, f, g] + dsimp only [num_edges] at h + rw [← h] + rw [← Multiset.sum_count_eq_card (hms ((Multiset.filter (fun e ↦ e = (u, v) ∨ e = (v, u)) G.edges)))] + -- Now simplify the count of a in the filtered multiset + have h_msum (u v : G.V) : Multiset.filter (λ e => e = (u, v) ∨ e = (v, u)) G.edges = Multiset.filter (λ e => e = ⟨u,v⟩) G.edges + Multiset.filter (λ e => e = ⟨v,u⟩) G.edges := by + apply Multiset.ext.mpr + intro e + simp only [count_add] + repeat rw [Multiset.count_filter] + by_cases h_e : e = ⟨u,v⟩ + · -- case: e = ⟨u,v⟩ + simp only [h_e, Prod.mk.injEq, true_or, ↓reduceIte, Nat.left_eq_add, ite_eq_right_iff, + count_eq_zero, and_imp] + intro h_eq _ + rw [h_eq] + exact G.loopless v + · -- case: e ≠ ⟨u,v⟩ + by_cases h_e' : e = ⟨v,u⟩ + · -- case: e = ⟨v,u⟩ + simp only [h_e', Prod.mk.injEq, or_true, ↓reduceIte, Nat.right_eq_add, ite_eq_right_iff, + count_eq_zero, and_imp] + intro h_eq _ + rw [h_eq] + exact G.loopless u + · -- case: e ≠ ⟨v,u⟩ + simp only [h_e, h_e', or_self, ↓reduceIte, add_zero] + rw [h_msum] + simp only [count_add] + rw [sum_add_distrib] + simp only [count_filter, sum_ite_eq', mem_univ, ↓reduceIte] + have lhs : ∑ u: G.V, ∑ v : G.V, (f u v + f v u)= 2 * Multiset.card O.directed_edges := by + simp only [sum_add_distrib] + dsimp only [flow, f] + nth_rewrite 2 [Finset.sum_comm] + rw [← two_mul] + have h_replace := double_sum (λ e : G.V × G.V => Multiset.count e O.directed_edges) + simp only [h_replace] + simp only [mem_univ, implies_true, sum_count_eq_card] + have rhs : ∑ u : G.V, ∑ v : G.V, (g u v + g v u) = 2 * Multiset.card G.edges := by + simp only [sum_add_distrib] + dsimp only [g] + nth_rewrite 2 [Finset.sum_comm] + rw [← two_mul] + have h_replace := double_sum (λ e : G.V × G.V => Multiset.count e G.edges) + simp only [h_replace] + simp only [mem_univ, implies_true, sum_count_eq_card] + simp only [h_uv] at lhs + rw [lhs] at rhs + linarith + +/-- The number of edges directed into a vertex under an orientation. -/ +def indeg (G : CFGraph) (O : CFOrientation G) (v : G.V) : ℕ := + Multiset.card (O.directed_edges.filter (λ e => e.snd = v)) + +/-- The in-degree of $v$ equals the sum of flows into $v$ from all vertices. -/ +private lemma indeg_eq_sum_flow {G : CFGraph} (O : CFOrientation G) (v : G.V) : + indeg G O v = ∑ w : G.V, flow O w v := by + dsimp only [indeg, flow] + suffices h_eq : (∀ S : Multiset (G.V × G.V) , ∀ v : G.V, + Multiset.card (S.filter (λ e => e.snd = v)) = ∑ u : G.V, Multiset.count (u, v) S) by + exact h_eq O.directed_edges v + -- Prove by induction on the set of directed edges, following the pattern of the proof of + -- degree_eq_total_flow in Basic.lean. I suspect the two can be unified. + intro S v + induction S using Multiset.induction_on with + | empty => + simp only [filter_zero, Multiset.card_zero] + simp only [notMem_zero, not_false_eq_true, count_eq_zero_of_notMem, sum_const_zero] + | cons e S ih => + simp only [Multiset.filter_cons, card_add, count_cons, sum_add_distrib] + rw [ih] + nth_rewrite 1 [add_comm] + apply add_left_cancel_iff.mpr + obtain ⟨eu,ev⟩ := e + by_cases h_ev_eq_v : ev = v + · -- Case ev = v + rw [h_ev_eq_v] + simp only [↓reduceIte, Multiset.card_singleton, Prod.mk.injEq, and_true, sum_ite_eq', + mem_univ] + · -- Case ev ≠ v + rw [ite_eq_right h_ev_eq_v, Multiset.card_zero] + -- Flip the sides of the equation in the goal + have : ∑ x : G.V, (if (x, v) = (eu, ev) then 1 else 0) = 0 := by + apply Finset.sum_eq_zero + intro x hx + simp only [Prod.mk.injEq, ite_eq_right_iff, one_ne_zero, imp_false, not_and] + intro _ + contrapose! h_ev_eq_v + rw [h_ev_eq_v] + -- refine Finset.sum_eq_zero ?_ + rw [this] + + +/-- The number of edges directed out of a vertex under an orientation. -/ +def outdeg (G : CFGraph) (O : CFOrientation G) (v : G.V) : ℕ := + Multiset.card (O.directed_edges.filter (λ e => e.fst = v)) + +/-- A vertex is a source if it has no incoming edges. -/ +def is_source (G : CFGraph) (O : CFOrientation G) (v : G.V) : Prop := + indeg G O v = 0 + +/-- The proposition `directed_edge G O u v` holds when there is a directed edge from $u$ +to $v$ in orientation $\mathcal{O}$. -/ +def directed_edge (G : CFGraph) (O : CFOrientation G) (u v : G.V) : Prop := + (u, v) ∈ O.directed_edges + +/-- A directed path in a graph under an orientation. -/ +structure DirectedPath {G : CFGraph} (O : CFOrientation G) where + /-- The sequence of vertices in the path. -/ + vertices : List G.V + /-- The path is nonempty. -/ + non_empty : vertices.length > 0 + /-- Every consecutive pair forms a directed edge. -/ + valid_edges : List.IsChain (directed_edge G O) vertices + +/-- A directed path is *non-repeating* if its vertex list has no duplicates. -/ +def non_repeating {G: CFGraph} {O : CFOrientation G} (p : DirectedPath O) : Prop := + p.vertices.Nodup + +/-- A non-repeating directed path has length at most $|V(G)|$. -/ +private lemma path_length_bound {G : CFGraph} {O : CFOrientation G} (p : DirectedPath O) : + non_repeating p → p.vertices.length ≤ Fintype.card G.V := by + intro h_distinct + exact List.Nodup.length_le_card h_distinct + +/-- An orientation is acyclic if every directed path has no repeated vertices. -/ +def is_acyclic (G : CFGraph) (O : CFOrientation G) : Prop := + ∀ (p : DirectedPath O), non_repeating p + +/-- Vertices that are not sources must have at least one incoming edge. -/ +private lemma indeg_ge_one_of_not_source (G : CFGraph) (O : CFOrientation G) (v : G.V) : + ¬ is_source G O v → indeg G O v ≥ 1 := by + intro h_not_source -- h_not_source : is_source G O v = false + unfold is_source at h_not_source -- h_not_source : (decide (indeg G O v = 0)) = false + apply Nat.one_le_iff_ne_zero.mpr -- Goal is indeg G O v ≠ 0 + intro h_eq_zero -- Assume indeg G O v = 0 + exact h_not_source h_eq_zero + +/-- For vertices that are not sources, $\mathrm{indeg}(v)-1$ is nonnegative. -/ +private lemma indeg_minus_one_nonneg_of_not_source (G : CFGraph) (O : CFOrientation G) (v : G.V) : + ¬ is_source G O v → 0 ≤ (indeg G O v : ℤ) - 1 := by + intro h_not_source + have h_indeg_ge_1 : indeg G O v ≥ 1 := indeg_ge_one_of_not_source G O v h_not_source + apply Int.sub_nonneg_of_le + exact Nat.cast_le.mpr h_indeg_ge_1 + + +/-- In an acyclic orientation, every nonempty subset of vertices contains a vertex with no +incoming flow from within the subset (a relative source). -/ +private lemma subset_source (G : CFGraph) (O : CFOrientation G) (S : Finset G.V): + S.Nonempty → is_acyclic G O → ∃ v ∈ S, ∀ w ∈ S, flow O w v = 0 := by + intro S_nonempty h_acyclic + by_contra! no_sourceless + + let S_path (p : DirectedPath O) : Prop := + ∀ v ∈ p.vertices, v ∈ S + + have arb_path (n : ℕ) : ∃ (p : DirectedPath O), S_path p ∧ p.vertices.length = n + 1:= by + induction n with + | zero => + · -- Base case: n = 0 + -- Create a list consisting of v only + rcases S_nonempty with ⟨v, h_v_in_S⟩ + use { + vertices := [v], + non_empty := by + simp only [List.length_cons, List.length_nil, zero_add, gt_iff_lt, Order.lt_one_iff], + valid_edges := List.isChain_singleton v + } + simp only [List.length_cons, List.length_nil, zero_add, and_true] + intro u h_u_in_path + rw [List.mem_singleton] at h_u_in_path + rw [h_u_in_path] + exact h_v_in_S + | succ n ih => + · -- Inductive step: assume true for n, prove for n + 1 + rcases ih with ⟨p, h_len⟩ + cases hp: p.vertices with + | nil => + -- This case should not happen since p.vertices has length n + 1 ≥ 1 + exfalso + rw [hp] at h_len + simp only [List.length_nil, Nat.right_eq_add, Nat.add_eq_zero_iff, one_ne_zero, + and_false] at h_len + | cons v p' => + specialize no_sourceless v + have v_S : v ∈ S := h_len.1 v (by simp only [hp, List.mem_cons, true_or]) + rcases (no_sourceless v_S) with h_no_parent + rcases h_no_parent with ⟨u, h_u⟩ + let new_path : List G.V := u :: p.vertices + use { + vertices := new_path, + non_empty := by + rw [List.length_cons] + exact Nat.succ_pos _, + valid_edges := by + dsimp only [new_path] + cases h_case : p.vertices with + | nil => + -- Path was just [v], so new path is [u, v] + simp only [List.IsChain.singleton] + | cons v' vs => + have eq_vv': v = v' := by + rw [h_case] at hp + simp only [List.cons.injEq] at hp + obtain ⟨h,_⟩ := hp + rw [h] + rw [← eq_vv'] + constructor + -- Show the new first link is a directed edge + have := h_u.2 + dsimp only [flow, ne_eq] at this + contrapose! this with h_no_edge + simp only [count_eq_zero] + exact h_no_edge + -- Now show the rest of the path is valid + have h_rec := p.valid_edges + rw [h_case] at h_rec + rw [← eq_vv'] at h_rec + exact h_rec + } + -- Show that the path lies in S + constructor + intro v h_v_in_path + simp only at h_v_in_path + dsimp only [new_path] at h_v_in_path + cases h_v_in_path with + | head h_eq_v => + exact h_u.1 + | tail _ h_v_in_tail => + exact h_len.1 v h_v_in_tail + -- Show the length is n + 2 + rw [List.length_cons] + rw [h_len.2] + specialize arb_path (Fintype.card G.V) + rcases arb_path with ⟨p, h_len⟩ + have ineq := path_length_bound p (h_acyclic p) + linarith + +/-- A nonempty graph with an acyclic orientation has at least one source. -/ +private lemma acyclic_has_source (G : CFGraph) (O : CFOrientation G) : + is_acyclic G O → ∃ v : G.V, is_source G O v := by + intro h_acyclic + have h := subset_source G O Finset.univ Finset.univ_nonempty h_acyclic + rcases h with ⟨v, _, h_source⟩ + use v + dsimp only [is_source] + rw [indeg_eq_sum_flow] + apply Finset.sum_eq_zero + exact h_source + +/-- If every source of an acyclic orientation must equal $q$, then $q$ is itself a source. -/ +private lemma is_source_of_unique_source {G : CFGraph} (O : CFOrientation G) {q : G.V} (h_acyclic : is_acyclic G O) + (h_unique_source : ∀ w, is_source G O w → w = q) : + is_source G O q := by + rcases acyclic_has_source G O h_acyclic with ⟨q', h_q'⟩ + specialize h_unique_source q' + have := h_unique_source h_q' + rw [this] at h_q' + exact h_q' + +/-- The proposition `acyclic_with_unique_source G O q` means that $\mathcal{O}$ is acyclic +and every source of $\mathcal{O}$ is equal to $q$. -/ +def acyclic_with_unique_source (G : CFGraph) (O : CFOrientation G) (q : G.V) : Prop := + is_acyclic G O ∧ ∀ w, is_source G O w → w = q + +/-- In an acyclic orientation with unique source $q$, the vertex $q$ is a source. -/ +private lemma source_of_acyclic_with_unique_source {G : CFGraph} {O : CFOrientation G} {q : G.V} + (hO : acyclic_with_unique_source G O q) : is_source G O q := + is_source_of_unique_source O hO.1 hO.2 + + +/-- The configuration associated to an acyclic orientation with unique source $q$ assigns +$\mathrm{indeg}(v)-1$ chips to each vertex $v \ne q$, and $0$ at $q$. -/ +def config_of_source {G : CFGraph} {O : CFOrientation G} {q : G.V} + (hO : acyclic_with_unique_source G O q) : Config G q := + { chips := λ v => if v = q then 0 else (indeg G O v : ℤ) - 1, + q_zero := by simp only [↓reduceIte] + non_negative := by + intro v + simp only [ge_iff_le] + split_ifs with h_eq + · linarith + · have h_not_source : ¬ is_source G O v := by + intro hs_v + exact h_eq (hO.2 v hs_v) + exact indeg_minus_one_nonneg_of_not_source G O v h_not_source + } + +/-! +## Orientation divisors and configurations + +For an orientation $\mathcal{O}$ of $G$, the *orientation divisor* `ordiv G O` is +$D(\mathcal{O})(v) = \mathrm{indeg}_{\mathcal{O}}(v) - 1$. + +For an acyclic orientation $\mathcal{O}$ with unique source $q$, the associated +*configuration* `orientation_to_config G O q` assigns $\mathrm{indeg}(v) - 1$ chips to +each vertex $v \ne q$. An acyclic orientation is uniquely determined by its in-degree +sequence (`orientation_determined_by_indegrees`), and the divisor of an acyclic orientation +is always $q$-reduced and unwinnable. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 4.7. +-/ + +/-- The divisor associated with an orientation assigns $\mathrm{indeg}(v)-1$ to each vertex. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 4.7, +part 1; written $D(\mathcal{O})$ there. -/ +def ordiv (G : CFGraph) (O : CFOrientation G) : CFDiv G := + λ v => indeg G O v - 1 + +/-- The orientation divisor `ordiv G O` bundled as a $q$-effective divisor, using +acyclicity to prove $q$-effectivity. -/ +def orqed {G : CFGraph} (O : CFOrientation G) {q : G.V} + (hO : acyclic_with_unique_source G O q) : q_eff_div G q := { + D := ordiv G O, + h_eff := by + intro v v_ne_q + dsimp only [ordiv] + contrapose! v_ne_q with v_q + have h_indeg : indeg G O v = 0 := by + linarith + rw [indeg_eq_sum_flow] at h_indeg + -- Sum of non-negative terms is zero, so each term is zero + apply hO.2 + contrapose! h_indeg with h_not_source + dsimp only [is_source] at h_not_source + rw [indeg_eq_sum_flow] at h_not_source + intro h_bad + rw [h_bad] at h_not_source + simp only [not_true_eq_false] at h_not_source + } + +/-- The configuration $c(\mathcal{O})$ associated to an acyclic orientation $\mathcal{O}$. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 4.7 +(part 2). -/ +def orientation_to_config (G : CFGraph) (O : CFOrientation G) (q : G.V) + (hO : acyclic_with_unique_source G O q) : Config G q := + config_of_source hO + +/-- The configuration associated to an orientation records the expected in-degree data. -/ +private lemma orientation_to_config_indeg (G : CFGraph) (O : CFOrientation G) (q : G.V) + (hO : acyclic_with_unique_source G O q) (v : G.V) : + (orientation_to_config G O q hO).chips v = + if v = q then 0 else (indeg G O v : ℤ) - 1 := by + -- This follows directly from the definition of config_of_source + simp only [orientation_to_config] at * + -- Use the definition of config_of_source + exact rfl + + + +/-- The configuration associated to an orientation agrees with the configuration obtained +from its orientation divisor. -/ +lemma config_and_divisor_from_O {G : CFGraph} (O : CFOrientation G) {q : G.V} + (hO : acyclic_with_unique_source G O q) : + orientation_to_config G O q hO = toConfig (orqed O hO) := by + let c := orientation_to_config G O q hO + let D := orqed O hO + rw [eq_config_iff_eq_chips] + funext v + by_cases h_v: v = q + · -- Case v = q + rw [h_v] + have (c d : Config G q) : c.chips q = d.chips q := by + rw [c.q_zero, d.q_zero] + rw [this] + · -- Case v ≠ q + dsimp only [orientation_to_config, config_of_source, orqed, toConfig, ordiv, Pi.sub_apply, + Pi.smul_apply, Int.zsmul_eq_mul] + simp only [h_v, ↓reduceIte, ne_eq, not_false_eq_true, one_chip_apply_other', mul_zero, sub_zero] + + +-- The double-counting lemmas `sum_filter_eq_map` and `sum_card_filter_eq_mul` used below +-- are proved at the end of Basic.lean. + + + + +/-- An acyclic orientation is uniquely determined by its in-degree sequence. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Lemma 4.3. -/ +lemma orientation_determined_by_indegrees {G : CFGraph} + (O O' : CFOrientation G) : + is_acyclic G O → is_acyclic G O' → + (∀ v : G.V, indeg G O v = indeg G O' v) → + O = O' := by + intro h_acyc h_acyc' h_indeg_eq + + let S := { e : G.V × G.V | O.directed_edges.count e > O'.directed_edges.count e } + have suff_S_empty : S = ∅ → O = O' := by + intro h_S_empty + have h_ineq (u v : G.V) : flow O u v ≤ flow O' u v := by + have h_nin: ⟨u,v⟩ ∉ S := by + rw [h_S_empty] + simp only [Set.mem_empty_iff_false, not_false_eq_true] + dsimp only [Set.mem_ofPred_eq, S] at h_nin + linarith + simp only [eq_orient O O'] + intro u v + by_contra h_neq + have h_uv_le := h_ineq u v + have h_lt : flow O u v < flow O' u v := lt_of_le_of_ne h_uv_le h_neq + have h_indeg_contra : indeg G O v < indeg G O' v := by + rw [indeg_eq_sum_flow O v, indeg_eq_sum_flow O' v] + apply Finset.sum_lt_sum + intro x hx + exact h_ineq x v + use u + simp only [mem_univ, h_lt, and_self] + linarith [h_indeg_eq v] + apply suff_S_empty + + -- A small helper we'll need a couple time later + have directed_edge_of_S (e : G.V × G.V) : e ∈ S → directed_edge G O e.1 e.2 := by + dsimp only [directed_edge] + intro h + dsimp only [Set.mem_ofPred_eq, S] at h + have h_pos_count : count e O.directed_edges > 0 := by + omega + apply Multiset.count_pos.mp + exact h_pos_count + + -- We now must show that S is empty. + -- Do so by showing any element in S belongs to an infinite directed path + have going_up : ∀ e ∈ S, ∃ f ∈ S, f.2 = e.1 := by + intro e h_e_in_S + obtain ⟨u,v⟩ := e + by_contra! h_no_parent + have all_flow_le : ∀ (w : G.V) , flow O w u ≤ flow O' w u := by + intro w + by_contra h_flow_gt + apply lt_of_not_ge at h_flow_gt + specialize h_no_parent ⟨w,u⟩ + simp only [ne_eq, not_true_eq_false, imp_false] at h_no_parent + exact h_no_parent h_flow_gt + have one_flow_lt : ∃ (w : G.V), flow O w u < flow O' w u := by + contrapose! h_e_in_S + dsimp only [Set.mem_ofPred_eq, S] + suffices flow O u v ≤ flow O' u v by linarith + specialize h_e_in_S v + by_contra flow_lt + apply lt_of_not_ge at flow_lt + have edges_lt := add_lt_add_of_le_of_lt h_e_in_S flow_lt + rw [opp_flow O v u, opp_flow O' v u] at edges_lt + linarith + + have h: ∑ (w : G.V), flow O w u < ∑ (w : G.V), flow O' w u := by + apply Finset.sum_lt_sum + intro i _ + exact all_flow_le i + rcases one_flow_lt with ⟨w, h_flow_lt⟩ + use w + constructor + simp only [mem_univ] + exact h_flow_lt + + repeat rw [← indeg_eq_sum_flow] at h + specialize h_indeg_eq u + linarith + + -- Suppose S is nonempty, and consider the set T of vertices where an edge of S + -- originates. By going_up, every vertex of T receives positive flow from another + -- vertex of T, contradicting the relative source provided by subset_source. + by_contra! h_S_nonempty + rcases h_S_nonempty with ⟨e_start, h_e_start_in_S⟩ + classical + let T : Finset G.V := Finset.univ.filter (fun v => ∃ e ∈ S, e.1 = v) + have h_mem_T : ∀ v : G.V, v ∈ T ↔ ∃ e ∈ S, e.1 = v := by + intro v + simp only [Prod.exists, exists_and_right, exists_eq_right, Finset.mem_filter, mem_univ, + true_and, T] + have h_T_nonempty : T.Nonempty := + ⟨e_start.1, (h_mem_T e_start.1).mpr ⟨e_start, h_e_start_in_S, rfl⟩⟩ + obtain ⟨v, h_v_T, h_v_source⟩ := subset_source G O T h_T_nonempty h_acyc + obtain ⟨e, h_e_S, h_e_fst⟩ := (h_mem_T v).mp h_v_T + obtain ⟨f, h_f_S, h_f_snd⟩ := going_up e h_e_S + have h_flow_pos : 0 < flow O f.1 v := by + rw [← h_e_fst, ← h_f_snd] + exact Multiset.count_pos.mpr (directed_edge_of_S f h_f_S) + have h_flow_zero : flow O f.1 v = 0 := + h_v_source f.1 ((h_mem_T f.1).mpr ⟨f, h_f_S, rfl⟩) + omega + +/-- Two acyclic orientations with unique source $q$ that give the same configuration are equal. -/ +private theorem config_to_orientation_unique (G : CFGraph) (q : G.V) + (c : Config G q) + (O₁ O₂ : CFOrientation G) + (hO₁ : acyclic_with_unique_source G O₁ q) + (hO₂ : acyclic_with_unique_source G O₂ q) + (h_eq₁ : orientation_to_config G O₁ q hO₁ = c) + (h_eq₂ : orientation_to_config G O₂ q hO₂ = c) : + O₁ = O₂ := by + apply orientation_determined_by_indegrees O₁ O₂ hO₁.1 hO₂.1 + intro v + + have h_deg₁ := orientation_to_config_indeg G O₁ q hO₁ v + have h_deg₂ := orientation_to_config_indeg G O₂ q hO₂ v + + have h_config_eq : (orientation_to_config G O₁ q hO₁).chips v = + (orientation_to_config G O₂ q hO₂).chips v := by + rw [h_eq₁, h_eq₂] + + by_cases hv : v = q + · -- Case v = q: Both vertices are sources, so indegree is 0 + rw [hv] + rw [source_of_acyclic_with_unique_source hO₁, source_of_acyclic_with_unique_source hO₂] + · -- Case v ≠ q: use vertex degree equality + rw [h_deg₁, h_deg₂] at h_config_eq + simp only [ite_eq_right hv] at h_config_eq + -- From config degrees being equal, show indegrees are equal + have h := congr_arg (fun x => x + 1) h_config_eq + simp only [sub_add_cancel] at h + -- Use nat cast injection + exact (Nat.cast_inj.mp h) + +/-- The degree of an orientation divisor equals $g - 1$, where $g$ is the genus of $G$. -/ +lemma degree_ordiv {G : CFGraph} (O : CFOrientation G) : + deg (ordiv G O) = (genus G) - 1 := by + have flow_sum : deg (ordiv G O) = (∑ v : G.V, ∑ w : G.V, ↑(flow O w v)) - (Fintype.card G.V) := by + calc + deg (ordiv G O) + = ∑ v : G.V, ordiv G O v := by rfl + _ = ∑ v : G.V, (∑ w : G.V, ↑(flow O w v) - 1) := by + apply Finset.sum_congr rfl + intro x _ + dsimp only [ordiv] + rw [indeg_eq_sum_flow O x] + simp only [Nat.cast_sum] + _ = (∑ v : G.V, ∑ w : G.V, ↑(flow O w v)) - (Fintype.card G.V) := by + rw [Finset.sum_sub_distrib] + simp only [sum_const, card_univ, Int.nsmul_eq_mul, mul_one] + dsimp only [genus] + rw [flow_sum] + suffices h : (∑ v : G.V, ∑ w : G.V, ↑(flow O w v)) = ↑(Multiset.card G.edges) by linarith [h] + calc + ∑ v : G.V, ∑ w : G.V, ↑(flow O w v) + = ∑ v : G.V, (indeg G O v) := by + apply Finset.sum_congr rfl + intro x _ + rw [indeg_eq_sum_flow] + _ = ∑ v : G.V, Multiset.card (O.directed_edges.filter (λ e => e.snd = v)) := by + dsimp only [indeg] + _ = ↑(Multiset.card O.directed_edges) := by + -- Each directed edge points into exactly one vertex + rw [sum_card_filter_eq_mul G O.directed_edges (λ v e => e.snd = v) 1 ?_, one_mul] + intro e _ + refine Finset.card_eq_one.mpr ⟨e.2, ?_⟩ + ext x + simp only [eq_comm, Finset.mem_filter, mem_univ, true_and, Finset.mem_singleton] + _ = ↑(Multiset.card G.edges) := by + exact card_directed_edges_eq_card_edges O + _ = Multiset.card G.edges := by + rfl + +/-- The configuration degree of an acyclic orientation with unique source equals the genus. -/ +lemma config_degree_from_O {G : CFGraph} (O : CFOrientation G) {q : G.V} + (hO : acyclic_with_unique_source G O q) : + config_degree (orientation_to_config G O q hO) = genus G := by + rw [config_and_divisor_from_O O hO] + -- Use config_degree_div_degree to relate config_degree to deg of the underlying divisor. + have h_q_source : indeg G O q = 0 := source_of_acyclic_with_unique_source hO + have h1 := config_degree_div_degree (orqed O hO) + -- (orqed O ...).D = ordiv G O definitionally, so: + have h2 : (orqed O hO).D q = (indeg G O q : ℤ) - 1 := rfl + have h3 : deg (orqed O hO).D = (genus G : ℤ) - 1 := degree_ordiv O + have h4 : (indeg G O q : ℤ) = 0 := by exact_mod_cast h_q_source + linarith + +/-- The orientation divisor $D(\mathcal{O})$ of an acyclic orientation $\mathcal{O}$ is not +winnable. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Proposition 4.11. -/ +lemma ordiv_unwinnable (G : CFGraph) (O : CFOrientation G) : + is_acyclic G O → ¬ winnable G (ordiv G O) := by + intro h_acyclic + by_contra h_win + let D := ordiv G O + rcases h_win with ⟨E, E_eff, E_equiv⟩ + dsimp only [Eff] at E_eff + dsimp only [linear_equiv] at E_equiv + rw [principal_iff_eq_prin] at E_equiv + rcases E_equiv with ⟨σ, h_σ⟩ + apply eq_add_of_sub_eq at h_σ + + obtain ⟨v_max, -, h_max⟩ := Finset.exists_max_image Finset.univ σ Finset.univ_nonempty + have h_max : ∀ w : G.V, σ w ≤ σ v_max := fun w => h_max w (Finset.mem_univ w) + let S := {v : G.V | σ v = σ v_max} + have S_nonempty : S.Nonempty := by + use v_max + simp only [Set.mem_ofPred_eq, S] + + have h_lt (u : G.V) (h_u : u ∉ S): σ u ≤ σ v_max - 1 := by + specialize h_max u + suffices σ u < σ v_max by linarith + apply lt_of_le_of_ne h_max + simp only [Set.mem_ofPred_eq, S] at h_u + exact h_u + + suffices h_v : ∃ v ∈ S, ∀ w : G.V, flow O w v > 0 → w ∉ S by + rcases h_v with ⟨v, h_v, h_flow⟩ + have h_prin : (prin G) σ v + indeg G O v ≤ 0 := by + rw [prin_apply] + rw [indeg_eq_sum_flow O v] + have h_diff : ∀ u : G.V, σ u - σ v ≤ if u ∈ S then 0 else -1 := by + intro u + by_cases h_u_in_S : u ∈ S + · simp only [h_u_in_S, ↓reduceIte, tsub_le_iff_right, zero_add] + -- Goal is now: σ u ≤ σ v + dsimp only [Set.mem_ofPred_eq, S] at h_u_in_S h_v + rw [h_u_in_S,h_v] + · simp only [h_u_in_S, ↓reduceIte, Int.reduceNeg, tsub_le_iff_right, le_neg_add_iff_add_le] + -- Goal is now: σ u - σ v ≤ -1 + dsimp only [Set.mem_ofPred_eq, S] at h_u_in_S h_v + have := h_lt u h_u_in_S + rw [h_v] + linarith [this] + have h_diff_mul : ∀ u : G.V, (σ u - σ v) * ↑(num_edges G v u) ≤ if u ∈ S then 0 else -↑(num_edges G v u) := by + intro u + by_cases h_u_in_S : u ∈ S + · simp only [h_u_in_S, ↓reduceIte] + dsimp only [Set.mem_ofPred_eq, S] at h_u_in_S h_v + rw [h_u_in_S,h_v] + simp only [sub_self, zero_mul, Std.le_refl] + · simp only [h_u_in_S, ↓reduceIte] + have ineq := h_lt u h_u_in_S + rw [← h_v] at ineq + apply le_of_sub_nonneg + rw [neg_eq_neg_one_mul, ← sub_mul] + apply mul_nonneg + linarith + exact Nat.cast_nonneg _ + have h_sum : ∑ w : G.V, (σ w - σ v) * ↑(num_edges G v w) ≤ ∑ w : G.V, if w ∈ S then 0 else -↑(num_edges G v w) := by + apply Finset.sum_le_sum + intro u _ + specialize h_diff_mul u + + exact h_diff_mul + suffices ∑ u : G.V, ((σ u - σ v) * ↑(num_edges G v u)) ≤ -↑ (∑ u: G.V, (flow O u v)) by linarith + refine le_trans h_sum ?_ + apply le_of_neg_le_neg + rw [neg_neg, Nat.cast_sum, neg_eq_neg_one_mul, mul_comm (-1), Finset.sum_mul] + + + apply sum_le_sum + + intro u _ + by_cases h_u_in_S : u ∈ S + · -- Case: u ∈ S. No edges from u to v. + simp only [h_u_in_S] + rw [ite_true] + contrapose! h_flow + use u + norm_num at h_flow + exact ⟨h_flow, h_u_in_S⟩ + · -- Case : u ∉ S. + simp only [h_u_in_S, ↓reduceIte, Int.reduceNeg, mul_neg, mul_one, neg_neg, Nat.cast_le] + -- Goal: flow O u v ≤ num_edges G v u + rw [← opp_flow O v u] + linarith + specialize E_eff v + rw [h_σ] at E_eff + rw [Pi.add_apply] at E_eff + dsimp only [ordiv] at E_eff + linarith + -- Now we must find a source of O relative to S + let S' := Finset.filter (λ v => v ∈ S) Finset.univ + have S'_nonempty : S'.Nonempty := by + rcases S_nonempty with ⟨v, h_v_in_S⟩ + use v + simp only [Finset.mem_filter, mem_univ, true_and, S'] + exact h_v_in_S + have h := subset_source G O S' S'_nonempty h_acyclic + rcases h with ⟨v, h_v_in_S', h_flow⟩ + use v + simp only [Finset.mem_filter, mem_univ, true_and, S'] at h_v_in_S' + constructor + · exact h_v_in_S' + · intro w h_flow_w_v + specialize h_flow w + by_contra! + have : w ∈ S' := by + simp only [Finset.mem_filter, mem_univ, true_and, S'] + exact this + apply h_flow at this + linarith + +/-- The orientation divisor $D(\mathcal{O})$ of an acyclic orientation with unique source $q$ +is $q$-reduced. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Proposition 4.11, which +asserts that $D(\mathcal{O})$ is maximal unwinnable; this lemma and `ordiv_unwinnable` +supply the unwinnability, while maximality is established in `RRGHelpers.lean`. -/ +private lemma ordiv_q_reduced {G : CFGraph} (O : CFOrientation G) {q : G.V} + (hO : acyclic_with_unique_source G O q) : q_reduced G q (ordiv G O) := by + constructor + · -- Show ordiv is effective away from q + intro v h_v_ne_q + simp only [ne_eq] at h_v_ne_q -- Now just ¬ v = q + dsimp only [ordiv] + suffices indeg G O v > 0 by + linarith + contrapose! h_v_ne_q with indeg_zero + apply hO.2 + apply Nat.eq_zero_of_le_zero at indeg_zero + dsimp only [is_source] + simp only [indeg_zero] + · -- Show no valid firing move exists for subsets not containing q + intro S h_q_S S_nonempty hlegal + have h_source := subset_source G O S S_nonempty hO.1 + rcases h_source with ⟨v, h_v_S, h_flow⟩ + apply (not_lt_of_ge (hlegal v h_v_S)) + dsimp only [ordiv] + -- Cancel -1 from both sides + apply Int.lt_of_le_sub_one + apply sub_le_sub_right + -- Expand indeg and compare terms + rw [indeg_eq_sum_flow O v, Nat.cast_sum] + -- Split the LHS sum into the x ∈ S part and the x ∉ S part + have flow_bound (w : G.V) : flow O w v ≤ if w ∈ S then 0 else num_edges G w v := by + by_cases h_w_in_S : w ∈ S + · -- Case: w ∈ S + simp only [h_w_in_S, ↓reduceIte, nonpos_iff_eq_zero, count_eq_zero] + specialize h_flow w + apply h_flow at h_w_in_S + dsimp only [flow] at h_w_in_S + -- Now deduce (w,v) ∉ O.directed_edges from count = 0. + exact Multiset.count_eq_zero.mp h_w_in_S + · -- Case: w ∉ S + simp only [h_w_in_S, ↓reduceIte] + rw [← opp_flow O w v] + linarith + have sum_flow_bound : ∑ w : G.V, ↑(flow O w v) ≤ ∑ w : G.V, if w ∈ S then 0 else ↑(num_edges G w v) := by + apply Finset.sum_le_sum + intro u _ + specialize flow_bound u + exact flow_bound + rw [Finset.sum_ite, sum_const,smul_zero, zero_add] at sum_flow_bound + -- Do some annoying casting business to remove ↑. + rw [outdeg_S_eq_sum_filter] + rw [← Nat.cast_sum, ← Nat.cast_sum] + apply Nat.cast_le.mpr + apply le_trans sum_flow_bound + -- Final step: we have num_edges G _ v on LHS and G v _ on the right. Use symmetry. + simp only [num_edges_symmetric, Std.le_refl] + +/-- The configuration associated to an acyclic orientation with unique source $q$ is +superstable. -/ +private lemma orientation_config_superstable (G : CFGraph) (O : CFOrientation G) (q : G.V) + (hO : acyclic_with_unique_source G O q) : + superstable G q (orientation_to_config G O q hO) := by + let c := orientation_to_config G O q hO + apply (superstable_iff_q_reduced G q (genus G -1) c).mpr + + have h_c := config_and_divisor_from_O O hO + dsimp only [c] + rw [h_c] + have : genus G - 1 = deg ((orqed O hO).D) := by + simpa only [orqed] using (degree_ordiv O).symm + rw [this] + rw [div_of_config_of_div (orqed O hO)] + exact ordiv_q_reduced O hO + + + +/-! +## The canonical divisor and reverse orientations + +The *canonical divisor* of $G$ is $K_G(v) = \deg(v) - 2$ for each vertex $v$. +The *reverse orientation* $\overline{\mathcal{O}}$ +of an orientation $\mathcal{O}$ is obtained by reversing all edge directions. The key +identity is $D(\mathcal{O}) + D(\overline{\mathcal{O}}) = K_G$ (`divisor_reverse_orientation`). + +Combining the handshaking theorem (`sum_vertex_degree_eq_twice_card_edges`, proved at the +end of `Basic.lean`) with the definition of the genus shows that $\deg(K_G) = 2g - 2$ +(`degree_of_canonical_divisor`). + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 5.7. +-/ + +/-- The canonical divisor assigns $\deg(v)-2$ to each vertex $v$. + +It is independent of orientation and equals +$D(\mathcal{O}) + D(\overline{\mathcal{O}})$. -/ +def canonical_divisor (G : CFGraph) : CFDiv G := + λ v => (vertex_degree G v) - 2 + +/-- Counting a pair in a multiset mapped by `Prod.swap` counts the swapped pair in the +original multiset. Specialization of `Multiset.count_map_eq_count'` to `Prod.swap`. -/ +private lemma count_map_swap {G : CFGraph} (M : Multiset (G.V × G.V)) (v w : G.V) : + Multiset.count (v, w) (M.map Prod.swap) = Multiset.count (w, v) M := + Multiset.count_map_eq_count' Prod.swap M Prod.swap_injective (w, v) + +/-- The *reverse orientation* $\overline{\mathcal{O}}$ obtained by reversing all edge directions. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 5.7. -/ +def CFOrientation.reverse (G : CFGraph) (O : CFOrientation G) : CFOrientation G where + directed_edges := O.directed_edges.map Prod.swap + count_preserving v w := by + rw [count_map_swap, count_map_swap, add_comm] + exact O.count_preserving v w + +/-- The flow of the reverse orientation $\overline{\mathcal{O}}$ from $v$ to $w$ equals the +flow of $\mathcal{O}$ from $w$ to $v$. -/ +private lemma flow_reverse {G : CFGraph} (O : CFOrientation G) (v w : G.V) : + flow (O.reverse G) v w = flow O w v := + count_map_swap O.directed_edges v w + +/-- The in-degree of $v$ in the reverse orientation $\overline{\mathcal{O}}$ equals the +out-degree of $v$ in $\mathcal{O}$. -/ +private lemma indeg_reverse_eq_outdeg (G : CFGraph) (O : CFOrientation G) (v : G.V) : + indeg G (O.reverse G) v = outdeg G O v := by + classical + simp only [indeg, outdeg] + rw [← Multiset.countP_eq_card_filter, ← Multiset.countP_eq_card_filter] + let O_rev_edges_def : (CFOrientation.reverse G O).directed_edges = O.directed_edges.map Prod.swap := by rfl + conv_lhs => rw [O_rev_edges_def] + rw [Multiset.countP_map] + simp only [Prod.snd_swap] + simp only [countP_eq_card_filter] + +/-- The reverse of an acyclic orientation is also acyclic. -/ +lemma is_acyclic_reverse_of_is_acyclic (G : CFGraph) (O : CFOrientation G) + (h_acyclic : is_acyclic G O) : + is_acyclic G (O.reverse G) := by + intro p + let q : DirectedPath O := { + vertices := p.vertices.reverse, + non_empty := by + rw [List.length_reverse] + exact p.non_empty, + valid_edges := by + have p_valid := p.valid_edges + have hyp := List.isChain_reverse.mpr p_valid + -- hyp : List.IsChain (flip (directed_edge G (CFOrientation.reverse G O))) p.vertices + -- Need to show: List.IsChain (directed_edge G (CFOrientation.reverse G O)) p.vertices.reverse + -- Since isChain_reverse gives us the flipped relation, we need to show + -- flip (directed_edge G (CFOrientation.reverse G O)) = directed_edge G O + convert hyp using 2 + ext a + simp only [directed_edge, CFOrientation.reverse, Multiset.mem_map, Prod.exists, + Prod.swap_prod_mk, Prod.mk.injEq, ↓existsAndEq, true_and, exists_eq_right] + } + have h_non_repeating_q : non_repeating q := h_acyclic q + exact List.nodup_reverse.mp h_non_repeating_q + + +/-- The orientation divisors of $\mathcal{O}$ and its reverse sum to the canonical divisor: +$D(\mathcal{O}) + D(\overline{\mathcal{O}}) = K_G$. -/ +lemma divisor_reverse_orientation {G : CFGraph} (O : CFOrientation G) : ordiv G O + ordiv G (O.reverse) = canonical_divisor G := by + let O' := O.reverse + funext v + rw [Pi.add_apply] + dsimp only [ordiv, canonical_divisor] + suffices indeg G O v + indeg G O' v = vertex_degree G v by + dsimp only [vertex_degree] at this ⊢ + rw [← this] + ring + rw [indeg_eq_sum_flow, indeg_eq_sum_flow, Nat.cast_sum, Nat.cast_sum] + dsimp only [vertex_degree] + rw [← sum_add_distrib] + apply Finset.sum_congr rfl + intro w _ + rw [← opp_flow O v w] + rw [Nat.cast_add, add_comm] + simp only [add_left_inj, Nat.cast_inj] + -- Goal is now: flow O' w v = flow O v w + rw [flow_reverse O w v] + +/-- The degree of the canonical divisor is $2g - 2$, where $g$ is the genus of $G$. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Exercise 5.8. -/ +theorem degree_of_canonical_divisor (G : CFGraph) : + deg (canonical_divisor G) = 2 * genus G - 2 := by + -- Use sum_sub_distrib to split the sum + have h1 : ∑ v, (canonical_divisor G v) = + ∑ v, vertex_degree G v - 2 * Fintype.card G.V := by + unfold canonical_divisor + rw [sum_sub_distrib] + simp only [sum_const, card_univ, Int.nsmul_eq_mul, sub_right_inj] + ring + dsimp only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] + rw [h1] + + -- Use the fact that sum of vertex degrees = 2|E| + have h2 : ∑ v, vertex_degree G v = 2 * Multiset.card G.edges := by + exact sum_vertex_degree_eq_twice_card_edges G + rw [h2] + + -- Use genus definition: g = |E| - |G.V| + 1 + rw [genus] + + ring + +/-! +## Orientations from burn lists + +Given a complete burn list $L$ for a superstable configuration $c$, the function +`burn_orientation L h_full` constructs an acyclic orientation of $G$ with unique source $q$ +(`burn_acyclic`, `burn_unique_source`). Acyclicity is proved by showing that position in +the burn list gives a strictly decreasing labeling along any directed path (`dp_dec`). + +The key lemma `dp_dec` formalizes this as a strict chain of natural numbers, and +`orientation_from_flow` constructs a `CFOrientation` from an explicit flow function. +-/ + +/-- Create a multiset with a given count function. This is a thin wrapper around +`DFinsupp.toMultiset` specialized to a finite type. -/ +def multiset_of_count {T : Type*} [DecidableEq T] [Fintype T] (f : T → ℕ) : Multiset T := + DFinsupp.toMultiset (DFinsupp.equivFunOnFintype.symm f) + +@[simp] private lemma count_of_multiset_of_count {T : Type*} [DecidableEq T] [Fintype T] + (f : T → ℕ) : ∀ e : T, Multiset.count e (multiset_of_count f) = f e := by + intro e + rw [← Multiset.toDFinsupp_apply] + calc + (Multiset.toDFinsupp (multiset_of_count f)) e = (DFinsupp.equivFunOnFintype.symm f) e := by + simp only [multiset_of_count, DFinsupp.toMultiset_toDFinsupp] + _ = f e := by + simpa only [DFinsupp.equivFunOnFintype_apply] + using congrFun (Equiv.apply_symm_apply DFinsupp.equivFunOnFintype f) e + +/-- Constructs a `CFOrientation` from an explicit flow function, given proofs that it respects +edge multiplicities and has no bidirectional edges. -/ +def orientation_from_flow {G : CFGraph} (f : G.V × G.V → ℕ) (h_count_preserving : ∀ v w : G.V, f (v,w) + f (w,v) = num_edges G v w) : CFOrientation G := + { + directed_edges := multiset_of_count f, + count_preserving := by + intro v w + simpa only [count_of_multiset_of_count] using (h_count_preserving v w).symm + } + +/-- The orientation constructed from a complete burn list $L$ for a superstable configuration, +via `burn_flow`. This is shown to be acyclic with unique source $q$ by `burn_acyclic` and +`burn_unique_source`. -/ +def burn_orientation {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (h_full : ∀ (v :G.V), v ∈ L.list): CFOrientation G := orientation_from_flow (burn_flow L) (burn_flow_reverse L h_full) + +/-- Along any directed path in `burn_orientation L`, the positions of vertices in the burn list +are strictly decreasing. This is the key lemma for proving acyclicity. -/ +private lemma dp_dec {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (h_full : ∀ (v :G.V), v ∈ L.list) (p : DirectedPath (burn_orientation L h_full)) : + List.IsChain (· > ·) (p.vertices.map (λ v => List.idxOf v L.list)) := by + refine List.isChain_map_of_isChain (f := fun v => List.idxOf v L.list) ?_ p.valid_edges + intro v v' h_edge + dsimp only [directed_edge] at h_edge + simp only [burn_orientation] at h_edge + dsimp only [orientation_from_flow] at h_edge + have h_count : Multiset.count ⟨v,v'⟩ (multiset_of_count (burn_flow L)) > 0 := by + contrapose! h_edge with h_zero + apply Nat.eq_zero_of_le_zero at h_zero + exact Multiset.count_eq_zero.mp h_zero + simp only [count_of_multiset_of_count, gt_iff_lt] at h_count + dsimp only [burn_flow] at h_count + by_contra! h_not_gt + have : ¬ (v ∈ L.list ∧ List.idxOf v' L.list < List.idxOf v L.list) := by + intro ⟨_, h_lt⟩ + omega + simp only [this, ↓reduceIte, lt_self_iff_false] at h_count + +/-- Every directed path in `burn_orientation L` has no repeated vertices. -/ +private lemma burn_nodup {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (h_full : ∀ (v :G.V), v ∈ L.list) (p : DirectedPath (burn_orientation L h_full)) : p.vertices.Nodup := by + let q : List ℕ := p.vertices.map (λ v => List.idxOf v L.list) + have h_sorted : q.SortedGT := (List.sortedGT_iff_isChain).2 (dp_dec L h_full p) + exact List.Nodup.of_map (λ v => List.idxOf v L.list) h_sorted.nodup + +/-- The orientation constructed from a complete burn list is acyclic. -/ +private lemma burn_acyclic {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (h_full : ∀ (v :G.V), v ∈ L.list) : + is_acyclic G (burn_orientation L h_full) := by + dsimp only [is_acyclic] + intro p + dsimp only [non_repeating] + exact burn_nodup L h_full p + +/-- The orientation constructed from a complete burn list has $q$ as its unique source. -/ +private lemma burn_unique_source {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (h_full : ∀ (v :G.V), v ∈ L.list) : + ∀ w, is_source G (burn_orientation L h_full) w → w = q := by + intro w h_source + dsimp only [is_source] at h_source + rw [indeg_eq_sum_flow (burn_orientation L h_full) w] at h_source + dsimp only [burn_orientation, orientation_from_flow, flow] at h_source + simp only [count_of_multiset_of_count] at h_source + -- Remove the decide and true parts + contrapose! h_source with h_ne + have ineq := burnin_degree L w (h_full w) h_ne + -- rw [Nat.cast_sum] at ineq + have : c.chips w ≥ 0 := by + apply c.non_negative w + let ineq := lt_of_le_of_lt this ineq + apply ne_of_lt at ineq + contrapose! ineq + rw [Nat.cast_sum] + simp only [Finset.sum_eq_zero_iff, mem_univ, forall_const] at ineq + simp only [ineq, CharP.cast_eq_zero, sum_const_zero] + +/-- The orientation constructed from a complete burn list is acyclic with unique source $q$. -/ +private lemma burn_acyclic_with_unique_source {G : CFGraph} {q : G.V} {c : Config G q} + (L : burn_list G c) (h_full : ∀ (v : G.V), v ∈ L.list) : + acyclic_with_unique_source G (burn_orientation L h_full) q := + ⟨burn_acyclic L h_full, burn_unique_source L h_full⟩ + + + +/-! +## The bijection between orientations and maximal superstable configurations + +This section establishes Theorem 4.8: there is a bijection between +acyclic orientations with unique source $q$ and maximal superstable configurations. + +- `superstable_dhar`: given a superstable configuration $c$, Dhar's algorithm produces an + acyclic orientation whose associated configuration dominates $c$. +- `orientation_config_maximal`: Every acyclic orientation with unique source $q$ gives a + maximal superstable configuration. +- `maximal_superstable_orientation`: Every maximal superstable configuration arises from + some acyclic orientation. +- `orientation_superstable_bijection`: The full bijection statement. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 4.8. +-/ + +/-- Dhar's burning algorithm produces, from a superstable configuration, an orientation whose +associated configuration dominates it. -/ +theorem superstable_dhar {G : CFGraph} {q : G.V} {c : Config G q} (h_ss : superstable G q c) : + ∃ (O : CFOrientation G) (hO : acyclic_with_unique_source G O q), + c ≤ orientation_to_config G O q hO := by + rcases superstable_burn_list G c h_ss with ⟨L, h_full⟩ + let O := burn_orientation L h_full + have hO : acyclic_with_unique_source G O q := burn_acyclic_with_unique_source L h_full + use O, hO + intro v + dsimp only [orientation_to_config, config_of_source] + by_cases h_vq : v = q + · -- Case: v = q + rw [h_vq] + simp only [↓reduceIte] + linarith [c.q_zero] + · -- Case: v ≠ q + simp only [h_vq, ↓reduceIte] + rw [indeg_eq_sum_flow O v] + dsimp only [flow] + dsimp only [burn_orientation, orientation_from_flow, O] + simp only [count_of_multiset_of_count] + have ineq := burnin_degree L v (h_full v) h_vq + linarith + +/-- The configuration associated to an acyclic orientation with unique source is maximal +superstable. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 4.8, +part 1 ($c(\mathcal{O})$ is maximal superstable). -/ +theorem orientation_config_maximal (G : CFGraph) (O : CFOrientation G) (q : G.V) + (hO : acyclic_with_unique_source G O q) : + maximal_superstable G (orientation_to_config G O q hO) := by + dsimp only [maximal_superstable] + let cO := orientation_to_config G O q hO + have h_ssO : superstable G q cO := orientation_config_superstable G O q hO + refine ⟨h_ssO, ?_⟩ + -- Goal is now just maximality of cO. + -- Suppose another divisor is bigger. There's an orientation divisor yet above that one. + intro c h_ss h_ge + rcases superstable_dhar h_ss with ⟨O', hO', h_ge'⟩ + let c' := orientation_to_config G O' q hO' + -- Sandwich c between cO and c', which have the same degree + have h_deg_le : config_degree cO ≤ config_degree c := config_degree_mono h_ge + have h_deg_le' : config_degree c ≤ config_degree c' := config_degree_mono h_ge' + rw [config_degree_from_O O hO] at h_deg_le + rw [config_degree_from_O O' hO'] at h_deg_le' + have h_deg : config_degree c = genus G := by + linarith + have h_deg : config_degree c = config_degree cO := by + rw [config_degree_from_O O hO] + exact h_deg + -- Now apply config equality from degree and ge + exact config_eq_of_le_and_degree h_ge h_deg + +/-- Every superstable configuration extends to a maximal superstable configuration. -/ +theorem maximal_superstable_exists (G : CFGraph) (q : G.V) (c : Config G q) + (h_super : superstable G q c) : + ∃ c' : Config G q, maximal_superstable G c' ∧ c ≤ c' := by + rcases superstable_dhar h_super with ⟨O, hO, h_ge⟩ + let c' := orientation_to_config G O q hO + use c' + refine ⟨?_, h_ge⟩ + -- Remains to show c' is maximal superstable + exact orientation_config_maximal G O q hO + +/-- Every maximal superstable configuration comes from an acyclic orientation. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 4.8, +part 2 (surjectivity). -/ +theorem maximal_superstable_orientation (G : CFGraph) (q : G.V) (c : Config G q) + (h_max : maximal_superstable G c) : + ∃ (O : CFOrientation G) (hO : acyclic_with_unique_source G O q), + orientation_to_config G O q hO = c := by + rcases superstable_dhar h_max.1 with ⟨O, hO, h_ge⟩ + use O, hO + let c' := orientation_to_config G O q hO + have h_eq := h_max.2 c' (orientation_config_superstable G O q hO) h_ge + exact h_eq + +/-- The bijection between acyclic orientations with unique source $q$ and maximal +superstable configurations. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 4.8, +part 3 (bijection). -/ +theorem orientation_superstable_bijection (G : CFGraph) (q : G.V) : + let α := {O : CFOrientation G // acyclic_with_unique_source G O q}; + let β := {c : Config G q // maximal_superstable G c}; + let f_raw : α → Config G q := λ O_sub => orientation_to_config G O_sub.val q O_sub.prop; + let f : α → β := λ O_sub => ⟨f_raw O_sub, orientation_config_maximal G O_sub.val q O_sub.prop⟩; + Function.Bijective f := by + -- Define the domain and codomain types explicitly (can be removed if using let like above) + let α := {O : CFOrientation G // acyclic_with_unique_source G O q} + let β := {c : Config G q // maximal_superstable G c} + -- Define the function f_raw : α → Config G q + let f_raw : α → Config G q := λ O_sub => orientation_to_config G O_sub.val q O_sub.prop + -- Define the function f : α → β, showing the result is maximal superstable + let f : α → β := λ O_sub => + ⟨f_raw O_sub, orientation_config_maximal G O_sub.val q O_sub.prop⟩ + + constructor + -- Injectivity + { -- Prove injective f using injective f_raw + intros O₁_sub O₂_sub h_f_eq -- h_f_eq : f O₁_sub = f O₂_sub + have h_f_raw_eq : f_raw O₁_sub = f_raw O₂_sub := by + simp only [Subtype.mk.injEq] at h_f_eq; exact h_f_eq + + -- Reuse original injectivity proof structure, ensuring types match + let ⟨O₁, h₁⟩ := O₁_sub + let ⟨O₂, h₂⟩ := O₂_sub + -- Define c, h_eq₁, h_eq₂ based on orientation_to_config directly + let c := orientation_to_config G O₁ q h₁ + have h_eq₁ : orientation_to_config G O₁ q h₁ = c := rfl + have h_eq₂ : orientation_to_config G O₂ q h₂ = c := by + exact h_f_raw_eq.symm.trans h_eq₁ + + apply Subtype.ext + exact config_to_orientation_unique G q c O₁ O₂ h₁ h₂ h_eq₁ h_eq₂ + } + + -- Surjectivity + { -- Prove Function.Surjective f + unfold Function.Surjective + intro y -- y should now have type β + -- Access components using .val and .property + let c_target : Config G q := y.val -- Explicitly type c_target + let h_target_max_superstable := y.property + + -- Use the fact that every maximal superstable config comes from an orientation. + rcases maximal_superstable_orientation G q c_target h_target_max_superstable with + ⟨O, hO, h_config_eq_target⟩ + + -- Construct the required subtype element x : α (the pre-image) + let x : α := ⟨O, hO⟩ + + -- Show that this x exists + use x + + -- Show f x = y using Subtype.eq + apply Subtype.ext + -- Goal: (f x).val = y.val + -- Need to show: f_raw x = c_target + -- This is exactly h_config_eq_target + exact h_config_eq_target + -- Proof irrelevance handles the equality of the property components. + } diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean b/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean new file mode 100644 index 0000000000..d76971eee4 --- /dev/null +++ b/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger +-/ +import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch + +namespace Propositions + +private lemma rank_eq_rank (G : CFGraph) (D : CFDiv G) (r : ℤ) + (h : rank_eq G D r) : rank G D = r := by + change rank_geq G D r ∧ ¬rank_geq G D (r + 1) at h + rw [rank_geq_iff, rank_geq_iff] at h + omega + +theorem riemann_roch {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : + ∀ r rdual : ℤ, rank_eq G D r → rank_eq G (canonical_divisor G - D) rdual → + r - rdual = deg D + 1 - genus G := by + intro r rdual h_rank h_rankdual + have hr : rank G D = r := rank_eq_rank G D r h_rank + have hrdual : rank G (canonical_divisor G - D) = rdual := + rank_eq_rank G (canonical_divisor G - D) rdual h_rankdual + have h_rr := riemann_roch_for_graphs h_conn D + rw [hr, hrdual] at h_rr + linarith + +theorem clifford {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : + ∀ r rdual : ℤ, rank_eq G D r → rank_eq G (canonical_divisor G - D) rdual → + 0 ≤ r → 0 ≤ rdual → (r : ℚ) ≤ (deg D : ℚ) / 2 := by + intro r rdual h_rank h_rankdual hr_nonneg hrdual_nonneg + have hr : rank G D = r := rank_eq_rank G D r h_rank + have hrdual : rank G (canonical_divisor G - D) = rdual := + rank_eq_rank G (canonical_divisor G - D) rdual h_rankdual + have h_clifford := clifford_theorem h_conn D (by simpa [hr] using hr_nonneg) + (by simpa [hrdual] using hrdual_nonneg) + rw [hr] at h_clifford + exact h_clifford + +end Propositions diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean b/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean new file mode 100644 index 0000000000..190b7e0ca3 --- /dev/null +++ b/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean @@ -0,0 +1,544 @@ +/- +Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger +-/ +import LeanPool.ChipFiring.ChipFiringWithLean.Orientation +import LeanPool.ChipFiring.ChipFiringWithLean.Rank + + +open Multiset Finset + +/-! +## Maximal superstable configurations and maximal unwinnable divisors + +This section establishes the correspondence between maximal superstable configurations and +maximal unwinnable divisors: + +- A superstable configuration $c$ is maximal if and only if $\deg(c) = g$ + (`maximal_superstable_config_prop`). +- A divisor $D$ is maximal unwinnable if and only if its canonical $q$-reduced representative + has the form $c-q$, with $c$ the associated maximal superstable configuration + (`maximal_unwinnable_char`). +- Every maximal unwinnable divisor has degree $g - 1$ (`maximal_unwinnable_deg`). +-/ + +/-- The chosen unique $q$-reduced representative of the linear equivalence class of $D$. -/ +noncomputable def qReducedRep {G : CFGraph} + (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : CFDiv G := + Classical.choose (unique_q_reduced h_conn q D) + +/-- The canonical representative is linearly equivalent to $D$ and is $q$-reduced. -/ +private lemma qReducedRep_spec {G : CFGraph} + (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : + linear_equiv G D (qReducedRep h_conn q D) ∧ q_reduced G q (qReducedRep h_conn q D) := + (Classical.choose_spec (unique_q_reduced h_conn q D)).1 + +/-- The configuration obtained from the canonical $q$-reduced representative of $D$ by +zeroing out the chips at $q$. -/ +noncomputable def qReducedConfig {G : CFGraph} + (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : Config G q := + toConfig ⟨qReducedRep h_conn q D, (qReducedRep_spec h_conn q D).2.1⟩ + +/-- The canonical configuration attached to $D$ is superstable. -/ +private lemma qReducedConfig_superstable {G : CFGraph} + (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : + superstable G q (qReducedConfig h_conn q D) := by + exact q_reduced_toConfig_superstable G q (qReducedRep h_conn q D) (qReducedRep_spec h_conn q D).2 + +/-- Every divisor $D$ is linearly equivalent to $c+kq$ for some superstable configuration +$c$ and integer $k$. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Remark 3.14. -/ +lemma superstable_of_divisor {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : + ∃ (c : Config G q) (k : ℤ), + linear_equiv G D (c.chips + k • (one_chip q)) ∧ + superstable G q c := by + let D' := qReducedRep h_conn q D + let c := qReducedConfig h_conn q D + use c, D' q + constructor + · + have h := (qReducedRep_spec h_conn q D).1 + rw [q_reduced_eq_chips_add_q G q (qReducedRep h_conn q D) (qReducedRep_spec h_conn q D).2] at h + exact h + · + simpa only using qReducedConfig_superstable h_conn q D + +/-- If $D$ is unwinnable and $D \sim c + k \cdot q$ for a superstable $c$, then $k < 0$. -/ +lemma superstable_of_divisor_negative_k (G : CFGraph) (q : G.V) (D : CFDiv G) : + ¬(winnable G D) → + ∀ (c : Config G q) (k : ℤ), + linear_equiv G D (c.chips + k • (one_chip q)) → + superstable G q c → + k < 0 := by + intro h_not_winnable c k h_equiv h_super + contrapose! h_not_winnable with k_nonneg + let D' := c.chips + k • (one_chip q) + have D'_eff : effective D' := by + rw [show D' = toDiv (config_degree c + k) c by + dsimp only [D'] + rw [toDiv_config_degree_add]] + exact (config_eff (config_degree c + k) c).2 (by linarith) + have h_winnable_D' : winnable G D' := winnable_of_effective G D' D'_eff + exact winnable_equiv_winnable G D' D h_winnable_D' h_equiv.symm + + +/-- If $D$ is maximal unwinnable and $q$-reduced, then $D(q) = -1$. -/ +private lemma maximal_unwinnable_q_reduced_chips_at_q (G : CFGraph) (q : G.V) (D : CFDiv G) : + maximal_unwinnable G D → q_reduced G q D → D q = -1 := by + intro h_max_unwin h_qred + have h_neg : D q < 0 := by + contrapose! h_max_unwin + unfold maximal_unwinnable + push Not + intro h_unwin + absurd h_unwin + suffices effective D by + exact winnable_of_effective G D this + intro v + by_cases hv : v = q + · rw [hv] + exact h_max_unwin + · exact h_qred.1 v (by simp only [ne_eq, hv, not_false_eq_true]) + have h_add_win : winnable G (D + one_chip q) := by exact (h_max_unwin.2 q) + have h_eff : effective (D + one_chip q) := by + apply effective_of_winnable_and_q_reduced G q (D + one_chip q) h_add_win + -- Prove q-reducedness of D + one_chip q + constructor + · intro v hv + have h_v_ne_q : v ≠ q := by + exact Set.mem_ofPred.mp hv + rw [Pi.add_apply] + simp only [ne_eq, h_v_ne_q, not_false_eq_true, one_chip_apply_other', add_zero, ge_iff_le] + apply h_qred.1 v hv + · intro S hq hS_nonempty hlegal + apply h_qred.2 S hq hS_nonempty + intro v hv_in_S + have hvq : v ≠ q := fun hvq => hq (hvq ▸ hv_in_S) + simpa only [Pi.add_apply, one_chip_apply_other' q v hvq, add_zero] using + hlegal v hv_in_S + have h_nonneg : D q + 1 ≥ 0 := by + have h := h_eff q + rw [Pi.add_apply] at h + simp only [one_chip_apply_v, ge_iff_le] at h + exact h + linarith + +/-- A maximal superstable configuration has degree equal to the genus. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 4.9(1), +"only if" direction. -/ +private lemma degree_max_superstable {G : CFGraph} {q : G.V} (c : Config G q) (h_max : maximal_superstable G c): config_degree c = genus G := by + have := maximal_superstable_orientation G q c h_max + rcases this with ⟨O, hO, h_orient_eq⟩ + rw [← h_orient_eq] + exact config_degree_from_O O hO + +/-- If $D$ is maximal unwinnable and $q$-reduced, then any configuration $c$ satisfying +`D = toDiv (deg D) c` must realize $D$ as $c-q$. This is the $q$-reduced core of the +cited statement. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 4.9(2), +"only if" direction. -/ +private lemma maximal_unwinnable_q_reduced_form (G : CFGraph) (q : G.V) (D : CFDiv G) (c : Config G q) : + maximal_unwinnable G D → q_reduced G q D → D = toDiv (deg D) c → D = c.chips - one_chip q := by + intro h_max_unwinnable h_qred h_toDeg + have h_c_eq : c = toConfig ⟨D, h_qred.1⟩ := by + apply (eq_config_iff_eq_div (deg D) c (toConfig ⟨D, h_qred.1⟩)).mpr + exact h_toDeg.symm.trans (q_reduced_toDiv_toConfig G q D h_qred).symm + calc + D = (toConfig ⟨D, h_qred.1⟩).chips - one_chip q := by + exact q_reduced_eq_chips_sub_one_chip G q D h_qred + (maximal_unwinnable_q_reduced_chips_at_q G q D h_max_unwinnable h_qred) + _ = c.chips - one_chip q := by rw [h_c_eq] + +/-- The degree of a superstable configuration is bounded above by the genus. -/ +private lemma superstable_degree_le_genus (G : CFGraph) (q : G.V) (c : Config G q) : + superstable G q c → config_degree c ≤ genus G := by + intro h_super + rcases maximal_superstable_exists G q c h_super with ⟨c_max, h_maximal, h_ge_c⟩ + rw [← degree_max_superstable c_max h_maximal] + exact config_degree_mono h_ge_c + +/-- If a superstable configuration has degree equal to the genus, then it is maximal. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 4.9(1), +"if" direction. -/ +private lemma maximal_superstable_of_degree_eq_genus (G : CFGraph) (q : G.V) (c : Config G q) : + superstable G q c → config_degree c = genus G → maximal_superstable G c := by + intro h_super h_deg_eq + -- Choose a maximal above c (we'll show it's equal to c) + have := maximal_superstable_exists G q c h_super + rcases this with ⟨c_max, h_maximal, h_ge_c⟩ + have c_max_deg : config_degree c_max = genus G := by + exact degree_max_superstable c_max h_maximal + let E := c_max.chips - c.chips + have E_eff : E ≥ 0 := by + intro v + specialize h_ge_c v + dsimp only [Pi.zero_apply, Pi.sub_apply, E] + linarith + have E_deg : deg E = 0 := by + dsimp only [E] + rw [map_sub] + dsimp only [config_degree] at h_deg_eq c_max_deg + rw [h_deg_eq, c_max_deg] + simp only [sub_self] + have E_0 : E = 0 := eff_degree_zero E E_eff E_deg + dsimp only [E] at E_0 + have : c_max.chips = c.chips := by + rw [← sub_eq_zero, E_0] + have : c_max = c := (eq_config_iff_eq_chips c_max c).mpr this + rw [← this] + exact h_maximal + +/-- A superstable configuration is maximal if and only if its degree equals the genus. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 4.9(1). -/ +private theorem maximal_superstable_config_prop (G : CFGraph) (q : G.V) (c : Config G q) : + superstable G q c → (maximal_superstable G c ↔ config_degree c = genus G) := by + intro h_super + constructor + { -- Forward direction: maximal_superstable → degree = g + intro h_max + exact degree_max_superstable c h_max + } + { -- Reverse direction: degree = g → maximal_superstable + intro h_deg + -- Apply the lemma that degree g implies maximality + exact maximal_superstable_of_degree_eq_genus G q c h_super h_deg } + + +/-- A divisor of degree at least $g$ is winnable. -/ +lemma winnable_of_deg_ge_genus {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : deg D ≥ genus G → winnable G D := by + intro h_deg_ge_g + let q := Classical.arbitrary G.V + rcases (exists_q_reduced_representative h_conn q D) with ⟨D_qred, h_equiv, h_qred⟩ + rcases (q_reduced_superstable_correspondence G q D_qred).mp h_qred with ⟨c, h_super, h_D_eq⟩ + have h_deg_c : config_degree c ≤ genus G := superstable_degree_le_genus G q c h_super + have D_deg : deg D = deg D_qred := linear_equiv_preserves_deg G D D_qred h_equiv + refine ⟨D_qred, ?_, h_equiv⟩ + -- D_qred = toDiv (deg D_qred) c is effective: there are enough chips at q, since + -- deg D_qred ≥ g ≥ config_degree c + rw [h_D_eq] + exact (config_eff _ c).mpr (by linarith) + +/-- Adding a chip anywhere to $c'-q$ makes it winnable when $c'$ is maximal superstable. -/ +private lemma maximal_superstable_chip_winnable {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (c' : Config G q) : + maximal_superstable G c' → + ∀ (v : G.V), winnable G (c'.chips- (one_chip q) + (one_chip v)) := by + intro h_max_superstable v + let D' := c'.chips - one_chip q + one_chip v + have deg_ineq : deg D' ≥ genus G := by + calc + deg D' = config_degree c' := by + dsimp only [D'] + simp only [_root_.map_add, deg_chips_sub_one_chip, config_degree, deg_one_chip, + sub_add_cancel] + _ = genus G := degree_max_superstable c' h_max_superstable + _ ≥ genus G := by rfl + exact winnable_of_deg_ge_genus h_conn D' deg_ineq + +/-- A maximal unwinnable $q$-reduced divisor is its canonical configuration minus one chip +at $q$. -/ +private lemma maximal_unwinnable_q_reduced_toConfig_form {G : CFGraph} (q : G.V) (D : CFDiv G) + (h_max : maximal_unwinnable G D) (h_qred : q_reduced G q D) : + D = (toConfig ⟨D, h_qred.1⟩).chips - one_chip q := by + exact q_reduced_eq_chips_sub_one_chip G q D h_qred + (maximal_unwinnable_q_reduced_chips_at_q G q D h_max h_qred) + +/-- A divisor of the form $c-q$ is maximal unwinnable when $c$ is maximal superstable. -/ +private lemma maximal_unwinnable_of_maximal_superstable_form {G : CFGraph} + (h_conn : graph_connected G) (q : G.V) (c : Config G q) : + maximal_superstable G c → maximal_unwinnable G (c.chips - one_chip q) := by + intro h_max_c + refine ⟨superstable_sub_chip_unwinnable q c h_max_c.1, ?_⟩ + intro v + exact maximal_superstable_chip_winnable h_conn q c h_max_c v + +/-- For a $q$-reduced divisor, maximal unwinnability is equivalent to the maximal +superstability of its canonical configuration together with the canonical $c-q$ form. -/ +private lemma maximal_unwinnable_q_reduced_toConfig_iff {G : CFGraph} + (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) (h_qred : q_reduced G q D) : + maximal_unwinnable G D ↔ + maximal_superstable G (toConfig ⟨D, h_qred.1⟩) ∧ + D = (toConfig ⟨D, h_qred.1⟩).chips - one_chip q := by + constructor + · intro h_max + constructor + · let c : Config G q := toConfig ⟨D, h_qred.1⟩ + have h_super_c : superstable G q c := q_reduced_toConfig_superstable G q D h_qred + have h_form_D : D = c.chips - one_chip q := by + exact maximal_unwinnable_q_reduced_toConfig_form q D h_max h_qred + by_contra h_not_max_c + rcases maximal_superstable_exists G q c h_super_c with ⟨c', h_max_c', h_ge⟩ + have h_ne : c' ≠ c := by + intro h_eq + apply h_not_max_c + simpa only [h_eq] using h_max_c' + have h_strict : ∃ v : G.V, c.chips v + 1 ≤ c'.chips v := by + by_contra h_no + push Not at h_no + have h_c'_le_c : c' ≤ c := by + intro v + linarith [h_no v] + exact h_ne ((le_antisymm h_ge h_c'_le_c).symm) + rcases h_strict with ⟨v, h_v_strict⟩ + have h_H_eff : effective (c'.chips - c.chips - one_chip v) := by + intro w + by_cases h_wv : w = v + · rw [h_wv] + simp only [Pi.sub_apply, one_chip, ↓reduceIte, Int.sub_nonneg] + linarith [h_ge v, h_v_strict] + · simp only [Pi.sub_apply, one_chip, h_wv, ↓reduceIte, sub_zero, Int.sub_nonneg] + linarith [h_ge w] + have h_D''_eq : + c'.chips - one_chip q = + (c'.chips - c.chips - one_chip v) + (D + one_chip v) := by + rw [h_form_D] + funext w + simp only [Pi.sub_apply, sub_eq_add_neg, Pi.add_apply, Pi.neg_apply] + abel_nf + have h_D''_unwin : ¬winnable G (c'.chips - one_chip q) := + superstable_sub_chip_unwinnable q c' h_max_c'.1 + apply h_D''_unwin + rw [h_D''_eq] + exact winnable_add_winnable G (c'.chips - c.chips - one_chip v) (D + one_chip v) + (winnable_of_effective G _ h_H_eff) (h_max.2 v) + · exact maximal_unwinnable_q_reduced_toConfig_form q D h_max h_qred + · rintro ⟨h_max_c, h_form⟩ + rw [h_form] + exact maximal_unwinnable_of_maximal_superstable_form h_conn q _ h_max_c + + +/-- A divisor $D$ is maximal unwinnable if and only if its canonical $q$-reduced +representative has the form $c-q$, with $c$ the associated maximal superstable +configuration. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 4.9(2), +in canonical form. -/ +theorem maximal_unwinnable_char {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : + maximal_unwinnable G D ↔ + maximal_superstable G (qReducedConfig h_conn q D) ∧ + qReducedRep h_conn q D = + (qReducedConfig h_conn q D).chips - one_chip q := by + let D' := qReducedRep h_conn q D + have h_qred_D' : q_reduced G q D' := (qReducedRep_spec h_conn q D).2 + have h_core := maximal_unwinnable_q_reduced_toConfig_iff h_conn q D' h_qred_D' + constructor + · intro h_max_unwinnable_D + have h_max_D' : maximal_unwinnable G D' := + maximal_unwinnable_preserved G D D' h_max_unwinnable_D (qReducedRep_spec h_conn q D).1 + simpa only [qReducedConfig] using h_core.mp h_max_D' + · intro h_can + have h_max_D' : maximal_unwinnable G D' := by + simpa only using h_core.mpr h_can + exact maximal_unwinnable_preserved G D' D h_max_D' (qReducedRep_spec h_conn q D).1.symm + +/-- A maximal unwinnable divisor has degree $g - 1$, computed from its canonical +$q$-reduced representative and canonical configuration. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 4.9(4). -/ +theorem maximal_unwinnable_deg + {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : + maximal_unwinnable G D → deg D = genus G - 1 := by + intro h_max_unwin + + let q := Classical.arbitrary G.V + + have h_char := maximal_unwinnable_char h_conn q D + have h_max_cfg : maximal_superstable G (qReducedConfig h_conn q D) := (h_char.mp h_max_unwin).1 + have h_rep_form : + qReducedRep h_conn q D = + (qReducedConfig h_conn q D).chips - one_chip q := (h_char.mp h_max_unwin).2 + have h_deg_D' : deg (qReducedRep h_conn q D) = genus G - 1 := calc + deg (qReducedRep h_conn q D) = + deg ((qReducedConfig h_conn q D).chips - one_chip q) := by rw [h_rep_form] + _ = config_degree (qReducedConfig h_conn q D) - 1 := + deg_chips_sub_one_chip (c := qReducedConfig h_conn q D) + _ = genus G - 1 := by rw [degree_max_superstable (qReducedConfig h_conn q D) h_max_cfg] + have h_deg_eq : deg D = deg (qReducedRep h_conn q D) := + linear_equiv_preserves_deg G D (qReducedRep h_conn q D) (qReducedRep_spec h_conn q D).1 + rw [h_deg_eq, h_deg_D'] + +/-- The map sending an acyclic orientation with source $q$ to the divisor +$v \mapsto \operatorname{indeg}(v) - \delta_{v,q}$ is injective, and every maximal +unwinnable divisor has degree $g - 1$. The divisor used here differs from +$D(\mathcal{O})$ by a fixed divisor, so injectivity is equivalent. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 4.9(3) +for the injectivity claim. -/ +theorem acyclic_orientation_maximal_unwinnable_correspondence_and_degree + {G : CFGraph} (h_conn : graph_connected G) (q : G.V) : + (Function.Injective (λ (O : {O : CFOrientation G // is_acyclic G O ∧ is_source G O q}) => + λ v => (indeg G O.val v) - if v = q then 1 else 0)) ∧ + (∀ D : CFDiv G, maximal_unwinnable G D → deg D = genus G - 1) := by + constructor + { -- Part 1: Injection proof + intros O₁ O₂ h_eq + have h_indeg : ∀ v : G.V, indeg G O₁.val v = indeg G O₂.val v := by + intro v + have := congr_fun h_eq v + by_cases hv : v = q + · have h₁ := O₁.prop.2; have h₂ := O₂.prop.2 + dsimp only [is_source] at h₁ h₂ + rw [hv, h₁, h₂] + · simp only [hv, ↓reduceIte, tsub_zero] at this + exact this + exact Subtype.ext (orientation_determined_by_indegrees O₁.val O₂.val O₁.prop.1 O₂.prop.1 h_indeg) + } + { -- Part 2: Degree characterization + -- This now correctly refers to the theorem defined above + intro D hD + exact maximal_unwinnable_deg h_conn D hD + } + +/-! +## Moderator divisors + +Following terminology of [Mikhalkin and Zharkov](https://arxiv.org/abs/math/0612267), a +*moderator* is the divisor $D(\mathcal{O})$ of an acyclic orientation $\mathcal{O}$. Moderators +encapsulate the key duality in the proof of Riemann-Roch: reversing the orientation carries +$D(\mathcal{O})$ to $K_G - D(\mathcal{O})$. +-/ + +/-- A *moderator* is a divisor of the form $D(\mathcal{O})$ for some acyclic orientation +$\mathcal{O}$. -/ +def is_moderator {G : CFGraph} (D : CFDiv G) : Prop := + ∃ (O : CFOrientation G), is_acyclic G O ∧ D = ordiv G O + +/-- If $D$ is a moderator, then so is $K_G - D$ (via the reverse orientation). This is the +key duality in the proof of Riemann-Roch. -/ +lemma moderator_symmetry {G : CFGraph} (D : CFDiv G) : + is_moderator D → is_moderator (canonical_divisor G - D) := by + rintro ⟨O, hO, h_D⟩ + use O.reverse + constructor + · exact is_acyclic_reverse_of_is_acyclic G O hO + · rw [h_D] + rw [← divisor_reverse_orientation O] + abel + +/-- Moderators have degree $g-1$. -/ +lemma moderator_degree {G : CFGraph} {D : CFDiv G} (h : is_moderator D) : deg D = genus G - 1 := by + rcases h with ⟨O, hO, rfl⟩ + exact degree_ordiv O + +/-- Moderators are unwinnable. -/ +lemma unwinnable_of_moderator {G : CFGraph} {D : CFDiv G} (h : is_moderator D) : ¬ winnable G D := by + rcases h with ⟨O, hO, rfl⟩ + exact ordiv_unwinnable G O hO + +/-- For every unwinnable divisor $D$, there exist a moderator $M$ and an effective divisor +$H$ with $M \sim D + H$. -/ +lemma moderator_of_unwinnable {G : CFGraph} (h_conn: graph_connected G) (D : CFDiv G) (unwin : ¬ winnable G D) : + ∃ (M H : CFDiv G), is_moderator M ∧ effective H ∧ linear_equiv G M (D+H) := by + let q := Classical.arbitrary G.V + rcases superstable_of_divisor h_conn q D with ⟨c, k, h_equiv, h_super⟩ + have h_k_neg : k < 0 := superstable_of_divisor_negative_k G q D unwin c k h_equiv h_super + rcases maximal_superstable_exists G q c h_super with ⟨c', h_max', h_ge⟩ + rcases maximal_superstable_orientation G q c' h_max' with ⟨O, hO, h_orient_eq_c'⟩ + let H : CFDiv G := -(k+1) • (one_chip q) + c'.chips - c.chips + have h_H_eff : effective H := by + have diff_eff : effective (c'.chips - c.chips) := by + rwa [sub_eff_iff_geq] + have src_eff : effective (-(k+1) • one_chip q) := by + intro v + rw [Pi.smul_apply, smul_eq_mul] + apply mul_nonneg + · -- Prove -(k + 1) ≥ 0 + linarith [h_k_neg] + · -- Prove one_chip q v ≥ 0 + exact eff_one_chip q v + have := (Eff G).add_mem src_eff diff_eff + rwa [← add_sub_assoc] at this + let M := c'.chips - one_chip q + have M_eq : linear_equiv G M (D + H) := by + simp only [linear_equiv, principal_iff_eq_prin, H, M] at ⊢ h_equiv + rcases h_equiv with ⟨σ, eq_σ⟩ + use (-σ) + rw [map_neg, ← eq_σ] + funext v; simp only [neg_add_rev, Int.reduceNeg, zsmul_eq_mul, Int.cast_add, Int.cast_neg, + Int.cast_one, Pi.sub_apply, Pi.add_apply, Pi.mul_apply, Pi.neg_apply, Pi.one_apply, + Pi.intCast_apply, Int.cast_eq, neg_sub]; ring + + have h_M_O : M = ordiv G O := by + have c'_eq : c' = toConfig (orqed O hO) := by + rw [← h_orient_eq_c'] + exact config_and_divisor_from_O O hO + + have : toDiv (genus G - 1) (toConfig (orqed O hO)) = ordiv G O := by + calc + toDiv (genus G - 1) (toConfig (orqed O hO)) + = toDiv (deg (orqed O hO).D) (toConfig (orqed O hO)) := by + have h_deg_orqed : deg (orqed O hO).D = genus G - 1 := by + simpa only [orqed] using degree_ordiv O + rw [h_deg_orqed] + _ = (orqed O hO).D := div_of_config_of_div (orqed O hO) + _ = ordiv G O := rfl + rw [← this] + dsimp only [toDiv, M] + rw [c'_eq] + have : (genus G - 1 - config_degree (toConfig (orqed O hO))) = -1 := by + have h_cfg_deg : config_degree (toConfig (orqed O hO)) = genus G := by + rw [← config_and_divisor_from_O O hO] + exact config_degree_from_O O hO + rw [h_cfg_deg] + ring + simp only [this, Int.reduceNeg, neg_smul, one_smul] + rw [sub_eq_add_neg] + have h_M_moderator : is_moderator M := by + exact ⟨O, ⟨hO.1, h_M_O⟩⟩ + use M, H + +/-! +## The main Riemann-Roch inequality + +`rank_degree_inequality` establishes the strict inequality +$$\deg(D) - g < r(D) - r(K_G - D),$$ +which is the main step toward the Riemann-Roch theorem for graphs. The proof chooses an +effective divisor $E$ of degree $r(D)+1$ with $D-E$ unwinnable, writes $M \sim (D-E)+F$ +for a moderator $M$ and effective divisor $F$ (`moderator_of_unwinnable`), and then +dualizes via `moderator_symmetry` to bound $r(K_G - D)$ by $\deg(F)$. +-/ + +/-- The strict Riemann-Roch inequality: $\deg(D) - g < r(D) - r(K_G - D)$. -/ +theorem rank_degree_inequality + {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : + deg D - genus G < rank G D - rank G (canonical_divisor G - D) := by + rcases rank_get_effective G D with ⟨E, E_eff, E_deg, D_E_unwin⟩ + rcases moderator_of_unwinnable h_conn (D - E) D_E_unwin with ⟨M, F, M_moderator, F_eff, M_equiv⟩ + set M' := canonical_divisor G - M with M'_eq + have M'_moderator : is_moderator M' := moderator_symmetry M M_moderator + + set D' := canonical_divisor G - D with D'_eq + have M'_equiv : linear_equiv G (D' - F + E) M' := by + rw [M'_eq] + dsimp only [linear_equiv, D'] + dsimp only [linear_equiv] at M_equiv + rw [principal_iff_eq_prin] at M_equiv ⊢ + rcases M_equiv with ⟨σ, eq_σ⟩ + use σ + rw [← eq_σ] + abel + + have h_D'_F : ¬ winnable G (D' - F) := by + by_contra! + have := winnable_add_winnable G (D' - F) E this (winnable_of_effective G E E_eff) + apply unwinnable_of_moderator M'_moderator + apply winnable_equiv_winnable G (D' - F + E) M' this M'_equiv + + have ineq : deg F > rank G D' := by + contrapose! h_D'_F + apply (rank_geq_iff G D' (deg F)).mpr at h_D'_F + dsimp only [rank_geq] at h_D'_F + specialize h_D'_F F ⟨F_eff, rfl⟩ + exact h_D'_F + + -- Finally, degree calculations to finish the inequality + have degF : deg F = - deg D + deg E + deg M := by + rw [linear_equiv_preserves_deg G M (D - E + F) M_equiv] + simp only [_root_.map_add, map_sub] + linarith + linarith [degF, moderator_degree M_moderator] diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean new file mode 100644 index 0000000000..b7a907dbf6 --- /dev/null +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean @@ -0,0 +1,352 @@ +/- +Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger +-/ +import LeanPool.ChipFiring.ChipFiringWithLean.Basic + + +open Multiset Finset + +/-! +## The rank function + +The *rank* of a divisor $D$ is the integer $r(D) \in \{-1, 0, 1, \ldots\}$ defined by +$r(D) \geq k$ if and only if $D - E$ is winnable for every effective divisor $E$ of degree $k$. +Equivalently, $r(D) \geq 0$ if and only if $D$ is winnable, and $r(D) = -1$ if and +only if $D$ is unwinnable. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Section 5.1. + +The rank is well-defined (`rank_exists`, `rank_unique`) and realized by the noncomputable +`rank` function. Key properties established here include: +- `rank_neg_one_iff_unwinnable`: $r(D) = -1 \iff D$ is unwinnable. +- `rank_nonneg_iff_winnable`: $r(D) \geq 0 \iff D$ is winnable. +- `rank_le_degree`: $r(D) \leq \deg(D)$ for $r(D) \geq 0$. +- `zero_divisor_rank`: $r(0) = 0$. + +A divisor $D$ is *maximal unwinnable* if it is unwinnable but $D + \delta_v$ is winnable +for every vertex $v$. Such divisors arise in the proof of the Riemann-Roch theorem. +-/ + +/-- Winnability is preserved under linear equivalence. -/ +lemma winnable_equiv_winnable (G : CFGraph) (D1 D2 : CFDiv G) : + winnable G D1 → linear_equiv G D1 D2 → winnable G D2 := by + rintro ⟨D1', h_D1'_eff, h_lequiv1⟩ h_lequiv + exact ⟨D1', h_D1'_eff, h_lequiv.symm.trans h_lequiv1⟩ + + +/-- A divisor is maximal unwinnable if it is unwinnable but adding a chip to any vertex +makes it winnable. -/ +def maximal_unwinnable (G : CFGraph) (D : CFDiv G) : Prop := + ¬winnable G D ∧ ∀ v : G.V, winnable G (D + one_chip v) + +/-- Being maximal unwinnable is preserved under linear equivalence. -/ +lemma maximal_unwinnable_preserved (G : CFGraph) (D1 D2 : CFDiv G) : + maximal_unwinnable G D1 → linear_equiv G D1 D2 → maximal_unwinnable G D2 := by + rintro ⟨h_unwin_D1, h_winnable_add⟩ h_lequiv + refine ⟨?_, ?_⟩ + · intro h_win_D2 + exact h_unwin_D1 <| winnable_equiv_winnable G D2 D1 h_win_D2 h_lequiv.symm + · intro v + exact winnable_equiv_winnable G (D1 + one_chip v) (D2 + one_chip v) (h_winnable_add v) <| by + unfold linear_equiv at * + simpa only [add_sub_add_right_eq_sub] using h_lequiv + +/-- The set of effective divisors of degree $k$. + +This is used to define `rank_geq`: the relation $r(D) \ge k$ means that $D-E$ is +winnable for every effective divisor $E$ of degree $k$. -/ +def eff_of_degree (G : CFGraph) (k : ℤ) : Set (CFDiv G) := + {E | effective E ∧ deg E = k} + +/-- For any nonnegative integer $k$, the set of effective divisors of degree $k$ is nonempty. -/ +private lemma eff_of_degree_nonempty (G : CFGraph) {k : ℤ} (h_nonneg : 0 ≤ k) : + (eff_of_degree G k).Nonempty := by + let v : G.V := Classical.arbitrary G.V + refine ⟨k.toNat • one_chip v, ?_, ?_⟩ + · exact (Eff G).nsmul_mem (eff_one_chip v) k.toNat + · simpa only [nsmul_eq_mul, deg_one_chip, Int.toNat_of_nonneg h_nonneg, mul_one] using + (AddMonoidHom.map_nsmul deg k.toNat (one_chip v)) + +/-- The relation $r(D) \ge k$: the game remains winnable after removing any effective +divisor of degree $k$. -/ +def rank_geq (G : CFGraph) (D : CFDiv G) (k : ℤ) : Prop := + ∀ E ∈ eff_of_degree G k, winnable G (D-E) + +/-- The relation $r(D)=r$: `rank_geq G D r` holds, but `rank_geq G D (r+1)` does not. -/ +def rank_eq (G : CFGraph) (D : CFDiv G) (r : ℤ) : Prop := + rank_geq G D r ∧ ¬(rank_geq G D (r+1)) + +/-- The relation `rank_geq G D k` holds vacuously for $k < 0$, since there are no effective +divisors of negative degree. -/ +private lemma rank_geq_neg (G : CFGraph) (D : CFDiv G) (k : ℤ): (k < 0) → rank_geq G D k := by + intro k_neg E ⟨h_eff_E, h_deg_E⟩ + have := deg_of_eff_nonneg E h_eff_E + linarith + +/-- A winnable divisor has nonnegative degree. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 1.16. -/ +private lemma deg_winnable_nonneg (G : CFGraph) (D : CFDiv G) (h_winnable : winnable G D) : deg D ≥ 0 := by + rcases h_winnable with ⟨D', h_D'_eff, h_lequiv⟩ + have same_deg: deg D = deg D' := linear_equiv_preserves_deg G D D' h_lequiv + rw [same_deg] + exact deg_of_eff_nonneg D' h_D'_eff + +/-- Every effective divisor is winnable (take $D' = D$ in the definition). -/ +lemma winnable_of_effective (G : CFGraph) (D : CFDiv G) (h_eff : effective D) : winnable G D := by + exact ⟨D, h_eff, by + unfold linear_equiv + rw [sub_self] + exact AddSubgroup.zero_mem (principal_divisors G)⟩ + +/-- The sum of two winnable divisors is winnable. -/ +lemma winnable_add_winnable (G : CFGraph) (D1 D2 : CFDiv G) + (h_winnable1 : winnable G D1) (h_winnable2 : winnable G D2) : winnable G (D1 + D2) := by + rcases h_winnable1 with ⟨D1', h_D1'_eff, h_lequiv1⟩ + rcases h_winnable2 with ⟨D2', h_D2'_eff, h_lequiv2⟩ + use D1' + D2' + refine ⟨(Eff G).add_mem h_D1'_eff h_D2'_eff, ?_⟩ + · + unfold linear_equiv at * + have : D1' + D2' - (D1 + D2) = (D1' - D1) + (D2' - D2) := by + rw [sub_add_sub_comm] + rw [this] + exact AddSubgroup.add_mem (principal_divisors G) h_lequiv1 h_lequiv2 + +/-- If $r(D) \ge r$ for some $r \ge 0$, then $r \le \deg(D)$. + +In particular, `rank G D ≤ deg D` when `rank G D ≥ 0`. -/ +lemma rank_le_degree (G : CFGraph) (D : CFDiv G) : ∀ (r : ℤ), r ≥ 0 → rank_geq G D r → r ≤ deg D := by + intro r r_nonneg h_rank + contrapose! h_rank + unfold rank_geq; push Not + rcases eff_of_degree_nonempty G r_nonneg with ⟨E, h_E_eff, h_E_deg⟩ + use E + constructor + -- First conjunct: show that E is effecitive of the correct degree + exact ⟨h_E_eff, h_E_deg⟩ + -- Second conjunct: show that D-E is not winnable + contrapose! h_rank + have deg_nonneg := deg_winnable_nonneg G (D-E) h_rank + simp only [map_sub, Int.sub_nonneg] at deg_nonneg + rw [h_E_deg] at deg_nonneg + exact deg_nonneg + +/-- The relation `rank_geq` is downward closed: if $r(D)\ge r_1$ and $r_2 \le r_1$, +then $r(D)\ge r_2$. -/ +private lemma rank_geq_trans (G : CFGraph) (D : CFDiv G) (r1 r2 : ℤ) : + rank_geq G D r1 → r2 ≤ r1 → rank_geq G D r2 := by + intro h_r1 h_leq + unfold rank_geq at * + contrapose! h_r1 + rcases h_r1 with ⟨E, ⟨h_E_eff,h_E_nonwin⟩⟩ + rcases eff_of_degree_nonempty G (sub_nonneg.mpr h_leq) with ⟨E_diff, h_Ediff_eff, h_Ediff_deg⟩ + use E + E_diff + constructor + · -- Show that E + E_diff is effective of degree r2 + constructor + apply (Eff G).add_mem + exact h_E_eff.left + exact h_Ediff_eff + -- Show degree + have E_deg := h_E_eff.right + simp only [_root_.map_add] at E_deg h_Ediff_deg ⊢ + linarith + . -- Show that D - (E + E_diff) is not winnable + contrapose! h_E_nonwin + have E_diff_winnable := winnable_of_effective G E_diff h_Ediff_eff + have sum_winnable := winnable_add_winnable G _ _ h_E_nonwin E_diff_winnable + simpa only [sub_eq_add_neg, neg_add_rev, add_comm, add_left_comm, add_neg_cancel_comm_assoc] + using sum_winnable + +/-- If $r(D) \ge r_1$ holds but $r(D) \ge r_2$ does not, then $r_1 < r_2$. -/ +lemma lt_of_rank_geq_not (G : CFGraph) (D : CFDiv G) (r1 r2 : ℤ) : + rank_geq G D r1 → ¬(rank_geq G D r2) → r1 < r2 := by + intro h_r1 h_r2 + contrapose! h_r2 + exact rank_geq_trans G D r1 r2 h_r1 h_r2 + +private lemma rank_eq_neg_one_iff_unwinnable (G : CFGraph) (D : CFDiv G) : + rank_eq G D (-1) ↔ ¬(winnable G D) := by + constructor + · intro h + rcases h with ⟨_, h_rank⟩ + contrapose! h_rank + simp only [Int.reduceNeg, neg_add_cancel] + intro E h_E + rcases h_E with ⟨h_eff_E, h_deg_E⟩ + have E_zero := eff_degree_zero _ h_eff_E h_deg_E + simpa only [E_zero, sub_zero] using h_rank + · intro h_unwinnable + refine ⟨rank_geq_neg G D (-1) (by norm_num), ?_⟩ + intro h_rank_geq + specialize h_rank_geq 0 + apply h_unwinnable + rw [sub_zero] at h_rank_geq + apply h_rank_geq + constructor + · dsimp only [effective, Pi.zero_apply] + norm_num + · simp only [_root_.map_zero, Int.reduceNeg, neg_add_cancel] + +/-- The inequality $r(D)\ge 0$ holds if and only if $D$ is winnable. -/ +lemma rank_nonneg_iff_winnable (G : CFGraph) (D : CFDiv G) : + rank_geq G D 0 ↔ winnable G D := by + constructor + · intro h_rank + specialize h_rank 0 + rw [sub_zero] at h_rank + exact h_rank <| by + simp only [eff_of_degree, effective, ge_iff_le, Set.mem_ofPred_eq, Pi.zero_apply, Std.le_refl, + implies_true, _root_.map_zero, and_self] + · intro h_winnable E ⟨h_eff_E, h_deg_E⟩ + have E_zero := eff_degree_zero _ h_eff_E h_deg_E + simpa only [E_zero, sub_zero] using h_winnable + +/-- If $r(D) \ge m$ fails for some natural number $m$, then there exists an exact rank +$r < m$. -/ +private lemma rank_exists_helper (G : CFGraph) (D : CFDiv G) (m : ℕ): ¬ (rank_geq G D m) → ∃ r < (m:ℤ), rank_eq G D r := by + induction m with + | zero => + · intro h_rank_geq + exact ⟨-1, by norm_num, rank_geq_neg G D (-1) (by norm_num), h_rank_geq⟩ + | succ m ih => + intro h_rank_geq + by_cases h_rank_m : rank_geq G D m + · exact ⟨m, by norm_num, h_rank_m, h_rank_geq⟩ + · + specialize ih h_rank_m + rcases ih with ⟨r, h_r_lt, h_rank_eq⟩ + have r_le : r < m + 1 := by + linarith [h_r_lt] + exact ⟨r, r_le, h_rank_eq⟩ + +/-- Every divisor has a well-defined rank: there exists an integer $r$ with $r(D)=r$. -/ +lemma rank_exists (G : CFGraph) (D : CFDiv G) : + ∃ r : ℤ, rank_eq G D r := by + let m := (deg D).toNat + 1 + have h_not_geq : ¬(rank_geq G D m) := by + intro h_rank_geq + have h_le := rank_le_degree G D m (by linarith) h_rank_geq + have m_ge : m ≥ deg D + 1:= by + dsimp only [Int.natCast_add, Int.cast_ofNat_Int, m] + simp only [Int.ofNat_toNat, ge_iff_le, add_le_add_iff_right, le_sup_left] + linarith + rcases rank_exists_helper G D m h_not_geq with ⟨r, _, h_rank_eq⟩ + exact ⟨r, h_rank_eq⟩ + +/-- The rank of a divisor is unique: if $r(D)=r_1$ and $r(D)=r_2$, then $r_1=r_2$. This is not + explicitly needed elsewhere, but is included for context. -/ +private lemma rank_unique (G : CFGraph) (D : CFDiv G) : + ∀ r1 r2 : ℤ, rank_eq G D r1 → rank_eq G D r2 → r1 = r2 := by + rintro r1 r2 ⟨h_r1_geq, h_r1_not_geq⟩ ⟨h_r2_geq, h_r2_not_geq⟩ + have ineq1 : r1 < r2 + 1 := lt_of_rank_geq_not G D r1 (r2+1) h_r1_geq h_r2_not_geq + have ineq2 : r2 < r1 + 1 := lt_of_rank_geq_not G D r2 (r1+1) h_r2_geq h_r1_not_geq + linarith + +/-- The rank function for divisors. -/ +noncomputable def rank (G : CFGraph) (D : CFDiv G) : ℤ := + Classical.choose (rank_exists G D) + +/-- The defining property of `rank`: it satisfies the relation `rank_eq`. -/ +private lemma rank_spec (G : CFGraph) (D : CFDiv G) : rank_eq G D (rank G D) := + Classical.choose_spec (rank_exists G D) + +/-- The relation `rank_geq G D k` is equivalent to the inequality `rank G D ≥ k`. -/ +lemma rank_geq_iff (G : CFGraph) (D : CFDiv G) (k : ℤ) : + rank_geq G D k ↔ rank G D ≥ k := by + constructor + · -- Forward direction + intro h_rank_geq + have := lt_of_rank_geq_not G D k (rank G D + 1) h_rank_geq (rank_spec G D).right + linarith + · -- Backward direction + intro h_rank_leq + exact rank_geq_trans G D (rank G D) k (rank_spec G D).left h_rank_leq + +/-- The relation `rank_eq G D r` is equivalent to the equality `rank G D = r`. -/ +private lemma rank_eq_iff (G : CFGraph) (D : CFDiv G) (r : ℤ) : + rank_eq G D r ↔ rank G D = r := by + dsimp only [rank_eq] + have split_eq x: x = r ↔ (x ≥ r ∧ ¬(x ≥ r + 1)) := by + rw [not_le] + rw [Int.lt_add_one_iff] + have helper := @le_antisymm_iff _ _ x r + rw [helper, and_comm] + rw [split_eq (rank G D)] + rw [rank_geq_iff G D r, rank_geq_iff G D (r+1)] + +/-- A divisor is winnable if and only if it is linearly equivalent to an effective divisor. -/ +lemma winnable_iff_exists_effective (G : CFGraph) (D : CFDiv G) : + winnable G D ↔ ∃ D' : CFDiv G, effective D' ∧ linear_equiv G D D' := by + simp only [winnable, mem_Eff] + + +/-- There is an effective divisor $E$ of degree $r(D)+1$ such that $D-E$ is not winnable. -/ +lemma rank_get_effective (G : CFGraph) (D : CFDiv G) : + ∃ E : CFDiv G, effective E ∧ deg E = rank G D + 1 ∧ ¬(winnable G (D-E)) := by + obtain ⟨_, h_r_not_geq⟩ := rank_spec G D + dsimp only [rank_geq] at h_r_not_geq + push Not at h_r_not_geq + rcases h_r_not_geq with ⟨E, ⟨h_E_eff, h_E_deg⟩, h_E_not_winnable⟩ + exact ⟨E, h_E_eff, h_E_deg, h_E_not_winnable⟩ + +/-- A divisor has rank $-1$ if and only if it is not winnable. -/ +lemma rank_neg_one_iff_unwinnable (G : CFGraph) (D : CFDiv G) : + rank G D = -1 ↔ ¬(winnable G D) := by + rw [← rank_eq_iff] + exact rank_eq_neg_one_iff_unwinnable G D + +/-- A divisor of negative degree has rank $-1$, i.e. is unwinnable. -/ +lemma rank_neg_one_of_deg_neg (G : CFGraph) (D : CFDiv G) (h_deg : deg D < 0) : + rank G D = -1 := by + rw [rank_neg_one_iff_unwinnable] + intro h_win + linarith [deg_winnable_nonneg G D h_win] + +/-- The rank of a divisor is at least $-1$. -/ +lemma rank_geq_neg_one (G : CFGraph) (D : CFDiv G) : rank G D ≥ -1 := + (rank_geq_iff G D (-1)).mp (rank_geq_neg G D (-1) (by norm_num)) + +/-- If the rank is not nonnegative, then it is $-1$. -/ +lemma rank_neg_one_of_not_nonneg (G : CFGraph) (D : CFDiv G) + (h_not_nonneg : ¬(rank G D ≥ 0)) : rank G D = -1 := by + have := rank_geq_neg_one G D + omega + +/-- The rank of the zero divisor is zero. -/ +lemma zero_divisor_rank (G : CFGraph) : rank G (0:CFDiv G) = 0 := by + rw [← rank_eq_iff] + constructor + have h_eff : effective (0:CFDiv G) := by + simp only [effective, Pi.zero_apply, ge_iff_le, Std.le_refl, implies_true] + rw [rank_nonneg_iff_winnable G (0:CFDiv G)] + exact winnable_of_effective G (0:CFDiv G) h_eff + have ineq := rank_le_degree G (0:CFDiv G) 1 (by norm_num) + simp only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk, Pi.zero_apply, sum_const_zero, Int.reduceLE, + imp_false] at ineq + exact ineq + +theorem one_le_apply_of_q_reduced_of_rank_geq_one {G : CFGraph} {q : G.V} + {D : CFDiv G} (hred : q_reduced G q D) (hrank : rank G D ≥ 1) : + 1 ≤ D q := by + classical + have hval : ∀ v : G.V, v ≠ q → (D - one_chip q) v = D v := by + intro v hv + simp [Pi.sub_apply, one_chip_apply_other' q v hv] + have hwin : winnable G (D - one_chip q) := + (rank_geq_iff G D 1).mpr hrank (one_chip q) ⟨eff_one_chip q, deg_one_chip q⟩ + have hred' : q_reduced G q (D - one_chip q) := by + refine ⟨fun v hv => by rw [hval v hv]; exact hred.1 v hv, ?_⟩ + intro S hq hSne hlegal + apply hred.2 S hq hSne + intro v hvS + rw [← hval v (fun hvq => hq (hvq ▸ hvS))] + exact hlegal v hvS + have heff : effective (D - one_chip q) := + effective_of_winnable_and_q_reduced G q _ hwin hred' + have hq := heff q + simp only [Pi.sub_apply, one_chip_apply_v] at hq + omega diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean b/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean new file mode 100644 index 0000000000..ed222ccf39 --- /dev/null +++ b/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean @@ -0,0 +1,384 @@ +/- +Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger +-/ +import LeanPool.ChipFiring.ChipFiringWithLean.RRGHelpers + + +universe u + +open Multiset Finset + +/-! +# Riemann-Roch for graphs + +The Riemann-Roch theorem for graphs and its main corollaries. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Chapter 5. +-/ + +/-- **Riemann-Roch theorem for graphs:** $r(D) - r(K_G - D) = \deg(D) + 1 - g$. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 5.9. -/ +theorem riemann_roch_for_graphs {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : + rank G D - rank G (canonical_divisor G - D) = deg D - genus G + 1 := by + set K := canonical_divisor G with K_eq + have h_ineq := rank_degree_inequality h_conn D + have h_ineq_rev : deg (K-D) - genus G < rank G (K-D) - rank G D := by + convert rank_degree_inequality h_conn (K-D) + abel + have deg_sub : deg (K-D) = deg K - deg D := by rw [deg.map_sub] + have h_deg_K : deg (canonical_divisor G) = 2 * genus G - 2 := degree_of_canonical_divisor G + linarith + +/-- $D$ is maximal unwinnable if and only if $K_G - D$ is maximal unwinnable. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 5.11. -/ +theorem maximal_unwinnable_symmetry + {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : + maximal_unwinnable G D ↔ maximal_unwinnable G (canonical_divisor G - D) := by + set K := canonical_divisor G with K_def + suffices ∀ (D : CFDiv G), maximal_unwinnable G D → maximal_unwinnable G (canonical_divisor G - D) by + constructor + exact this D + intro h + apply this (K-D) at h + rw [sub_sub_self] at h + exact h + -- Now we can just prove the forward direction + intro D h_max_unwin + -- Get rank = -1 from maximal unwinnable + have h_rank_neg : rank G D = -1 := by + rw [rank_neg_one_iff_unwinnable] + exact h_max_unwin.1 + + -- Get degree = g-1 from maximal unwinnable + have h_deg : deg D = genus G - 1 := maximal_unwinnable_deg h_conn D h_max_unwin + + -- Use Riemann-Roch + have h_RR := riemann_roch_for_graphs h_conn D + rw [h_rank_neg] at h_RR + + -- Get degree of K-D + have h_deg_K := degree_of_canonical_divisor G + have h_deg_KD : deg (canonical_divisor G - D) = genus G - 1 := by + rw [deg.map_sub] + rw [h_deg_K, h_deg] + linarith + + constructor + · -- K-D is unwinnable + rw [←rank_neg_one_iff_unwinnable] + linarith + · -- Adding chip makes K-D winnable + intro v -- Goal: winnable G ((K-D) + δᵥ) + -- Let E = (K-D) + δᵥ + set E : CFDiv G := (canonical_divisor G - D) + one_chip v with E_def + suffices winnable G E by + exact this + -- To show E is winnable, we will use Riemann-Roch on E + have h_deg_E : deg E = genus G := by + rw [E_def, deg.map_add, deg_one_chip, h_deg_KD] + linarith + apply (rank_nonneg_iff_winnable G E).mp + rw [rank_geq_iff G E] + calc + rank G E = rank G (K-E) + deg E +1 - genus G := by + linarith [riemann_roch_for_graphs h_conn E] + _ ≥ deg E - genus G := by + linarith [rank_geq_neg_one G (K - E)] + _ = 0 := by linarith[h_deg_E] + +/-- The rank function is subadditive: +$$ +r(D_1+D_2) \ge r(D_1)+r(D_2). +$$ +-/ +private lemma rank_subadditive (G : CFGraph) (D D' : CFDiv G) + (h_D : rank G D ≥ 0) (h_D' : rank G D' ≥ 0) : + rank G (D+D') ≥ rank G D + rank G D' := by + -- Express the two (nonnegative) ranks as natural numbers + obtain ⟨k₁, h_k₁⟩ : ∃ k : ℕ, (k : ℤ) = rank G D := ⟨_, Int.toNat_of_nonneg h_D⟩ + obtain ⟨k₂, h_k₂⟩ : ∃ k : ℕ, (k : ℤ) = rank G D' := ⟨_, Int.toNat_of_nonneg h_D'⟩ + + -- Show rank is ≥ k₁ + k₂ by proving rank_geq + have h_rank_geq : rank_geq G (D + D') (k₁ + k₂) := by + -- Take any effective divisor E'' of degree k₁ + k₂ + rintro E'' ⟨h_eff, h_deg⟩ + + -- Decompose E'' into E₁ and E₂ of degrees k₁ and k₂ + obtain ⟨E₁, E₂, h_E₁_eff, h_E₂_eff, h_E₁_deg, h_E₂_deg, h_sum⟩ := + effective_divisor_decomposition G E'' k₁ k₂ h_eff h_deg + + -- Apply rank_geq to get winnability for both parts + have h_D_win := (rank_geq_iff G D k₁).mpr (le_of_eq h_k₁) E₁ ⟨h_E₁_eff, h_E₁_deg⟩ + have h_D'_win := (rank_geq_iff G D' k₂).mpr (le_of_eq h_k₂) E₂ ⟨h_E₂_eff, h_E₂_deg⟩ + + -- Show winnability of sum + rw [h_sum] + have h := winnable_add_winnable G (D-E₁) (D'-E₂) h_D_win h_D'_win + rw [show D - E₁ + (D' - E₂) = (D + D') - (E₁ + E₂) by abel] at h + exact h + + have h_final := (rank_geq_iff G (D+D') (k₁+k₂)).mp h_rank_geq + linarith + +/-- **Clifford's theorem:** If $r(D) \geq 0$ and $r(K_G - D) \geq 0$, then +$r(D) \leq \frac12 \deg(D)$. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 5.13. -/ +theorem clifford_theorem + {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) + (h_D : rank G D ≥ 0) + (h_KD : rank G (canonical_divisor G - D) ≥ 0) : + (rank G D : ℚ) ≤ (deg D : ℚ) / 2 := by + -- Get canonical divisor K's rank using Riemann-Roch + have h_K_rank : rank G (canonical_divisor G) = genus G - 1 := by + -- Apply Riemann-Roch with D = K + have h_rr := riemann_roch_for_graphs h_conn (canonical_divisor G) + -- For K-K = 0, rank is 0 + have h_K_minus_K : rank G (canonical_divisor G - canonical_divisor G) = 0 := by + -- Show that this divisor is the zero divisor + have h1 : (canonical_divisor G - canonical_divisor G) = 0 := by + simp only [sub_self] + -- Show that the zero divisor has rank 0 + have h2 : rank G 0 = 0 := zero_divisor_rank G + -- Substitute back + rw [h1, h2] + -- Substitute into Riemann-Roch + rw [h_K_minus_K] at h_rr + -- Use degree_of_canonical_divisor + rw [degree_of_canonical_divisor] at h_rr + -- Solve for rank G K + linarith + + -- Apply rank subadditivity + have h_subadd := rank_subadditive G D (canonical_divisor G - D) h_D h_KD + -- The sum D + (K-D) = K + have h_sum : (D + (canonical_divisor G - D)) = canonical_divisor G := by + funext v + simp only [Pi.add_apply, Pi.sub_apply, add_sub_cancel] + rw [h_sum] at h_subadd + rw [h_K_rank] at h_subadd + + -- Use Riemann-Roch to get r(K-D) in terms of r(D) + have h_rr := riemann_roch_for_graphs h_conn D + + -- Combining subadditivity and Riemann-Roch gives 2 r(D) ≤ deg D; conclude in ℚ + have h_two : 2 * rank G D ≤ deg D := by linarith + have h_two' : (2 : ℚ) * (rank G D : ℚ) ≤ (deg D : ℚ) := by exact_mod_cast h_two + linarith + +/-- The rank of a divisor in terms of its degree: + - $\deg(D) < 0 \Rightarrow r(D) = -1$ + - $0 \leq \deg(D) \leq 2g-2 \Rightarrow r(D) \leq \deg(D)/2$ + - $\deg(D) > 2g-2 \Rightarrow r(D) = \deg(D) - g$. + +See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 5.14. -/ +theorem rank_nonspecial_range + {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : + -- Part 1 + (deg D < 0 → rank G D = -1) ∧ + -- Part 2 + (0 ≤ (deg D : ℚ) ∧ (deg D : ℚ) ≤ 2 * (genus G : ℚ) - 2 → (rank G D : ℚ) ≤ (deg D : ℚ) / 2) ∧ + -- Part 3 + (deg D > 2 * genus G - 2 → rank G D = deg D - genus G) := by + constructor + · -- Part 1: deg(D) < 0 implies r(D) = -1 + exact rank_neg_one_of_deg_neg G D + + constructor + · -- Part 2: 0 ≤ deg(D) ≤ 2g-2 implies r(D) ≤ deg(D)/2 + intro ⟨h_deg_nonneg, h_deg_upper⟩ + by_cases h_rank : rank G D ≥ 0 + · -- Case where r(D) ≥ 0 + let K := canonical_divisor G + by_cases h_rankKD : rank G (K - D) ≥ 0 + · -- Case where r(K-D) ≥ 0: use Clifford's theorem + exact clifford_theorem h_conn D h_rank h_rankKD + · -- Case where r(K-D) = -1: use Riemann-Roch + have h_rr := riemann_roch_for_graphs h_conn D + rw [rank_neg_one_of_not_nonneg G (K - D) h_rankKD] at h_rr + -- So r(D) = deg D - g, which is at most deg D / 2 since deg D ≤ 2g - 2 + have h_rank_eq : rank G D = deg D - genus G := by linarith + rw [h_rank_eq] + push_cast + linarith + + · -- Case where r(D) < 0 + rw [rank_neg_one_of_not_nonneg G D h_rank] + push_cast + linarith + + · -- Part 3: deg(D) > 2g-2 implies r(D) = deg(D) - g + intro h_deg_large + -- K-D has negative degree, hence rank -1 + have h_rankKD : rank G (canonical_divisor G - D) = -1 := by + apply rank_neg_one_of_deg_neg + rw [deg.map_sub, degree_of_canonical_divisor] + linarith + -- Apply Riemann-Roch to get r(D) = deg(D) - g + have h_rr := riemann_roch_for_graphs h_conn D + rw [h_rankKD] at h_rr + linarith + +/-! +## Gonality + +The Riemann-Roch theorem provides some basic information about the *(divisorial) gonality* +of a graph. +-/ + +/-- The relation $\operatorname{gon}(G) \le k$: there exists a divisor of degree $k$ +with rank at least $1$. -/ +def gonality_leq (G : CFGraph) (k : ℤ) : Prop := ∃ D : CFDiv G, rank G D ≥ 1 ∧ deg D = k + +/-- The relation $\operatorname{gon}(G) \ge k$: no divisor of degree less than $k$ +has rank at least $1$. -/ +def gonality_geq (G : CFGraph) (k : ℤ) : Prop := + ∀ l : ℤ, l < k → ¬ gonality_leq G l + +/-- A connected graph has gonality at most $g+1$, where $g$ is its genus. -/ +theorem gonality_leq_genus_add_one + {G : CFGraph} (h_conn : graph_connected G) : gonality_leq G (genus G + 1) := by + let q : G.V := Classical.arbitrary G.V + let D : CFDiv G := (genus G + 1) • one_chip q + have h_deg_D : deg D = genus G + 1 := by + dsimp only [D] + rw [map_zsmul, deg_one_chip, zsmul_one] + simp only [Int.cast_add, Int.cast_eq, Int.cast_one] + have h_rank_geq : rank_geq G D 1 := by + intro E hE + dsimp only [eff_of_degree, Set.mem_ofPred_eq] at hE + rcases hE with ⟨hE_eff, hE_deg⟩ + have h_deg_sub : deg (D - E) = genus G := by + rw [deg.map_sub, h_deg_D, hE_deg] + ring + apply winnable_of_deg_ge_genus h_conn (D - E) + rw [h_deg_sub] + refine ⟨D, (rank_geq_iff G D 1).mp h_rank_geq, h_deg_D⟩ + +private theorem one_le_of_gonality_leq {G : CFGraph} {k : ℤ} (h_gon : gonality_leq G k) : 1 ≤ k := by + rcases h_gon with ⟨D, h_rank, h_deg⟩ + have h_rank_geq : rank_geq G D 1 := (rank_geq_iff G D 1).mpr h_rank + have h_deg_lower : (1 : ℤ) ≤ deg D := rank_le_degree G D 1 (by norm_num) h_rank_geq + simpa only [ge_iff_le, h_deg] using h_deg_lower + +/-- The *(divisorial) gonality* of a connected graph is the smallest degree of a divisor +of rank at least one. -/ +noncomputable def gonality {G : CFGraph} (_h_conn : graph_connected G) : ℤ := + sInf {k : ℤ | gonality_leq G k} + +/-- A connected graph has gonality at most $g+1$, where $g$ is its genus. -/ +private lemma gonality_le_genus_add_one {G : CFGraph} (h_conn : graph_connected G) : + gonality h_conn ≤ genus G + 1 := by + let S : Set ℤ := {k : ℤ | gonality_leq G k} + have h_bdd : BddBelow S := by + refine ⟨1, ?_⟩ + intro k hk + exact one_le_of_gonality_leq hk + dsimp only [gonality] + exact csInf_le h_bdd (gonality_leq_genus_add_one h_conn) + +/-- The gonality of a connected graph is at least $1$. -/ +private lemma gonality_ge_one {G : CFGraph} (h_conn : graph_connected G) : 1 ≤ gonality h_conn := by + let S : Set ℤ := {k : ℤ | gonality_leq G k} + have h_nonempty : S.Nonempty := by + refine ⟨genus G + 1, ?_⟩ + exact gonality_leq_genus_add_one h_conn + dsimp only [gonality] + refine le_csInf h_nonempty ?_ + intro k hk + exact one_le_of_gonality_leq hk + +/-- The relation `gonality_geq G k` is equivalent to the inequality `gonality h_conn ≥ k`. -/ +@[simp] theorem gonality_geq_iff {G : CFGraph} (h_conn : graph_connected G) (k : ℤ) : + gonality_geq G k ↔ gonality h_conn ≥ k := by + let S : Set ℤ := {l : ℤ | gonality_leq G l} + have h_nonempty : S.Nonempty := by + refine ⟨genus G + 1, ?_⟩ + exact gonality_leq_genus_add_one h_conn + have h_bdd : BddBelow S := by + refine ⟨1, ?_⟩ + intro l hl + exact one_le_of_gonality_leq hl + constructor + · intro h_geq + dsimp only [gonality] + refine le_csInf h_nonempty ?_ + intro l hl + by_contra hlt + have hlt' : l < k := by linarith + exact h_geq l hlt' hl + · intro h_gon l hl h_leq + have h_inf_le : gonality h_conn ≤ l := by + dsimp only [gonality] + exact csInf_le h_bdd h_leq + linarith + +/-! +## Conjectures + +This section records conjectures and theorems about gonality and Brill-Noether theory for +graphs that have not been formalized here. +-/ + +/-- The existence of graphs with maximum gonality: for every $g \ge 0$, there exists +a connected graph of genus $g$ with gonality exactly $\lfloor (g+3)/2 \rfloor$. + +Posed by M. Baker in +[Specialization of linear systems from curves to graphs](https://doi.org/10.2140/ant.2008.2.613), +Conjecture 3.10(2). This is proved by Cools-Draisma-Payne-Robeva in +[A tropical proof of the Brill-Noether theorem](https://doi.org/10.1016/j.aim.2012.02.019), +and via a different construction by Hendrey in +[Sparse graphs of high gonality](https://doi.org/10.1137/16M1095329). We are not aware +of a formalization of this result. -/ +def max_gonality_existence (g : ℕ) : Prop := + ∃ (G : CFGraph.{u}) (h_conn : graph_connected G) (_g_eq : genus G = g), + gonality h_conn = (g + 3) / 2 + +/-- The statement that in a given genus $g$, there exists a Brill-Noether general graph: +a graph with no divisor of degree $d$ and rank at least $r$ whenever +$$ +\rho = g - (r+1)(g-d+r) < 0. +$$ + +The statement below uses the Riemann-Roch-equivalent form +$$ +(r(D)+1)(r(K_G-D)+1) \le g +$$ +for all divisors $D$, to avoid coercions between natural numbers and integers. + +This is a slightly strengthened form of a conjecture posed in M. Baker, +[Specialization of linear systems from curves to graphs](https://doi.org/10.2140/ant.2008.2.613), +namely Conjecture 3.9(2). It was proved by Cools-Draisma-Payne-Robeva in +[A tropical proof of the Brill-Noether theorem](https://doi.org/10.1016/j.aim.2012.02.019), +but we are not aware of a formalization of this result. -/ +def brill_noether_general_existence (g : ℤ) : Prop := + ∃ (G : CFGraph.{u}) (_h_conn : graph_connected G) (_g_eq : genus G = g), + ∀ (D : CFDiv G), (rank G D + 1) * (rank G (canonical_divisor G - D) + 1) ≤ g + +/-- The gonality conjecture for finite graphs: every connected graph of genus $g$ has gonality +at most $\lfloor (g+3)/2 \rfloor$. + +This is an open problem, posed by Baker in +[Specialization of linear systems from curves to graphs](https://doi.org/10.2140/ant.2008.2.613), +Conjecture 3.10(1). -/ +def gonality_conjecture {G : CFGraph} (h_conn : graph_connected G) : Prop := + gonality h_conn ≤ (genus G + 3) / 2 + +/-- The Brill-Noether conjecture for finite graphs: for every connected graph of genus $g$ +and integers $r,d$ with +$$ +\rho = g - (r+1)(g-d+r) \ge 0, +$$ +there exists a divisor of degree $d$ and rank at least $r$. + +This is an open problem, posed in slightly different form by Baker in +[Specialization of linear systems from curves to graphs](https://doi.org/10.2140/ant.2008.2.613), +Conjecture 3.9(1). -/ +def brill_noether_conjecture {G : CFGraph} (_h_conn : graph_connected G) (r d : ℤ) : Prop := + let g := genus G + let ρ := g - (r + 1) * (g - d + r) + 0 ≤ ρ → ∃ (D : CFDiv G), rank G D ≥ r ∧ deg D = d diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 95e0c8ad83..dc3db86e60 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -9966,3 +9966,39 @@ projects: msc: - '90C35' - '05C21' + - slug: chip-firing-with-lean + title: Chip-Firing with Lean 4 + summary: A Lean 4 / Mathlib formalization of Baker and Norine's Riemann-Roch theorem for + finite graphs. Chip configurations on a finite graph, modulo chip-firing moves, form an + abelian group analogous to the group of line bundles on a compact Riemann surface. Each + class can be assigned a rank, analogous to the dimension of a linear series. These ranks + then satisfy a formula of the form r(D) - r(K-D) = deg D + 1 - g, in exact analogy to + Riemann surfaces. This formula is formalized, along with the analog of Clifford's theorem + for finite graphs. + branch: combinatorics + entry_module: LeanPool.ChipFiring + authors: + - Dhyey Dharmendrakumar Mavani + - Nathan Pflueger + source: + url: https://github.com/dhyeymavani2003/chip-firing-with-lean + github_repo: dhyeymavani2003/chip-firing-with-lean + commit: 5b422d855c02af60591121ba7c11b5e8242542b8 + license: Apache-2.0 + status: verified + main_declarations: + - Propositions.riemann_roch + - Propositions.clifford + main_results: + - declaration: Propositions.riemann_roch + informal: For a finite connected graph, the ranks of a divisor and its canonical complement + satisfy the graph Riemann–Roch formula. + - declaration: Propositions.clifford + informal: For a special divisor on a finite connected graph, its rank is at most half + its degree. + tags: + - combinatorics + msc: + - 05C57 + - 14T20 + provenance: mix From b03e243ffb166d7685c49d411aeeb762a3ef5b85 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 19:13:37 +0000 Subject: [PATCH 2/9] Complete full chip-firing port and local verification --- LeanPool/ChipFiring/ChipFiringWithLean.lean | 6 + .../ChipFiringWithLean/Algorithms.lean | 232 ++--- .../ChipFiring/ChipFiringWithLean/Basic.lean | 811 +++++++++--------- .../ChipFiringWithLean/CFGraphExample.lean | 169 ++-- .../ChipFiring/ChipFiringWithLean/Config.lean | 346 ++++---- .../ChipFiringWithLean/Orientation.lean | 471 +++++----- .../ChipFiringWithLean/PalomarSolution.lean | 26 +- .../ChipFiringWithLean/RRGHelpers.lean | 224 +++-- .../ChipFiring/ChipFiringWithLean/Rank.lean | 139 +-- .../ChipFiringWithLean/RiemannRoch.lean | 129 ++- 10 files changed, 1305 insertions(+), 1248 deletions(-) diff --git a/LeanPool/ChipFiring/ChipFiringWithLean.lean b/LeanPool/ChipFiring/ChipFiringWithLean.lean index 547136826b..a4432e9446 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean.lean @@ -13,3 +13,9 @@ import LeanPool.ChipFiring.ChipFiringWithLean.Algorithms import LeanPool.ChipFiring.ChipFiringWithLean.Rank import LeanPool.ChipFiring.ChipFiringWithLean.RRGHelpers import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch + +/-! +# ChipFiringWithLean + +Chip firing, graph divisors, and their combinatorial properties. +-/ diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean index b04c678a0a..0c2e103a5c 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean @@ -5,9 +5,6 @@ Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ import LeanPool.ChipFiring.ChipFiringWithLean.Orientation - -namespace CF - /-! ## Experimental computational algorithms for chip-firing @@ -21,11 +18,16 @@ In particular, the core mathematical statements about $q$-reduced divisors, supe and Dhar's algorithm are proved elsewhere in the library. -/ + +namespace CF + + + open Finset BigOperators List /-- Checks whether a divisor is effective, meaning that all vertex values are nonnegative. -/ @[simp] -def is_effective (D : CFDiv G) : Bool := decide (∀ v, D v ≥ 0) +def isEffective (D : CFDiv G) : Bool := decide (∀ v, D v ≥ 0) /-- A small size measure used only to set conservative default loop fuel. -/ private def divisorMagnitude (G : CFGraph) (D : CFDiv G) : Nat := @@ -39,6 +41,29 @@ private def greedyFuel (G : CFGraph) (D : CFDiv G) : Nat := private def nonSourceChipCount (G : CFGraph) (q : G.V) (D : CFDiv G) : Nat := ∑ v ∈ Finset.univ.erase q, Int.toNat (D v) +/-- Fuel-bounded greedy borrowing loop, recording vertices visited and the accumulated +firing script. -/ +noncomputable def greedyWinnableLoop (G : CFGraph) (current_D : CFDiv G) (M : Finset G.V) + (script : CFDiv G) (fuel : Nat) : Bool × Option (CFDiv G) := + if _h_fuel_zero : fuel = 0 then (false, none) -- Fuel exhaustion implies failure + else if isEffective current_D then (true, some script) + else if M = Finset.univ then (false, none) -- All vertices borrowed, still not effective + else + -- Find any in-debt vertex. The marked set only records which vertices have + -- borrowed at least once; it does not prevent a vertex from borrowing again. + match Finset.univ.toList.find? (fun v => current_D v < 0) with + | some v => + let next_D := borrowingMove G current_D v + let next_M := insert v M + -- Update script: decrement count for borrowing vertex v + let next_script : CFDiv G := script - oneChip v + greedyWinnableLoop G next_D next_M next_script (fuel - 1) + | none => -- No vertex is in debt, but `D` is not effective. + -- This state implies unwinnability because we can't make progress. + (false, none) +termination_by fuel +decreasing_by simp_wf; exact Nat.pos_of_ne_zero _h_fuel_zero -- Simpler explicit proof + /-- The greedy algorithm for the dollar game (Corry-Perkinson, Algorithm 1). @@ -50,37 +75,19 @@ and `script` is the net borrowing count for each vertex if winnable. -/ @[simp] noncomputable def greedyWinnable (G : CFGraph) (D : CFDiv G) : Bool × Option (CFDiv G) := - let rec loop (current_D : CFDiv G) (M : Finset G.V) (script : CFDiv G) (fuel : Nat) : Bool × Option (CFDiv G) := - if _h_fuel_zero : fuel = 0 then (false, none) -- Fuel exhaustion implies failure - else if is_effective current_D then (true, some script) - else if M = Finset.univ then (false, none) -- All vertices borrowed, still not effective - else - -- Find any in-debt vertex. The marked set only records which vertices have - -- borrowed at least once; it does not prevent a vertex from borrowing again. - match Finset.univ.toList.find? (fun v => current_D v < 0) with - | some v => - let next_D := borrowing_move G current_D v - let next_M := insert v M - -- Update script: decrement count for borrowing vertex v - let next_script : CFDiv G := script - one_chip v - loop next_D next_M next_script (fuel - 1) - | none => -- No vertex is in debt, but `D` is not effective. - -- This state implies unwinnability because we can't make progress. - (false, none) - termination_by fuel - decreasing_by simp_wf; exact Nat.pos_of_ne_zero _h_fuel_zero -- Simpler explicit proof -- Initial call with generous fuel let max_fuel := greedyFuel G D - loop D ∅ (0 : CFDiv G) max_fuel -- Initialize script as (0 : CFDiv G) + greedyWinnableLoop G D ∅ (0 : CFDiv G) max_fuel -- Initialize script as (0 : CFDiv G) /-- Finds a burnable vertex $v \in S$, meaning one satisfying $c(v) < \operatorname{outdeg}_S(v)$. Returns `some v` if found, `none` otherwise. -/ -noncomputable def findBurnableVertex (G : CFGraph) (c : G.V → ℤ) (S : Finset G.V) : Option { v : G.V // v ∈ S } := +noncomputable def findBurnableVertex (G : CFGraph) (c : G.V → ℤ) (S : Finset G.V) : Option { v : + G.V // v ∈ S } := -- Iterate through the list representation and find the first match -- Need to get proof v ∈ S, which is guaranteed by iterating S.toList - let p := fun v => decide (c v < outdeg_S G S v) -- Use decide + let p := fun v => decide (c v < outdegS G S v) -- Use decide match h : S.toList.find? p with -- Use find? directly now (List is open) | some v => -- Prove v is in the original finset S @@ -89,6 +96,20 @@ noncomputable def findBurnableVertex (G : CFGraph) (c : G.V → ℤ) (S : Finset some ⟨v, h_mem_finset⟩ | none => none +/-- Fuel-bounded deletion of burnable vertices, returning the remaining stable set. -/ +noncomputable def dharBurningSetLoop (G : CFGraph) (c : G.V → ℤ) (S : Finset G.V) (fuel : Nat) : + Finset G.V := + -- Check fuel for termination safety + if _h_fuel_zero : fuel = 0 then S -- Name hypothesis + else + match findBurnableVertex G c S with + -- If a burnable vertex v is found, remove it and recurse + | some ⟨v, hv⟩ => dharBurningSetLoop G c (S.erase v) (fuel - 1) + -- If no burnable vertex found in S, S is stable, return it + | none => S +termination_by fuel +decreasing_by simp_wf; exact Nat.pos_of_ne_zero _h_fuel_zero -- Simpler explicit proof + /-- The core iterative burning process of Dhar's algorithm (Corry-Perkinson, Algorithm 2). @@ -102,24 +123,30 @@ The implementation uses well-founded recursion on the size of $S$. @[simp] noncomputable def dharBurningSet (G : CFGraph) (q : G.V) (c : G.V → ℤ) : Finset G.V := let initial_S := Finset.univ.erase q - let rec loop (S : Finset G.V) (fuel : Nat) : Finset G.V := - -- Check fuel for termination safety - if _h_fuel_zero : fuel = 0 then S -- Name hypothesis - else - match findBurnableVertex G c S with - -- If a burnable vertex v is found, remove it and recurse - | some ⟨v, hv⟩ => loop (S.erase v) (fuel - 1) - -- If no burnable vertex found in S, S is stable, return it - | none => S - termination_by fuel - decreasing_by simp_wf; exact Nat.pos_of_ne_zero _h_fuel_zero -- Simpler explicit proof - loop initial_S (Fintype.card G.V + 1) + dharBurningSetLoop G c initial_S (Fintype.card G.V + 1) /-- Fires every vertex in $S$, starting from the divisor $D$. -/ @[simp] noncomputable def fireSet (G : CFGraph) (D : CFDiv G) (S : Finset G.V) : CFDiv G := -- Use foldl directly now (List is open) - foldl (fun current_D v => firing_move G current_D v) D S.toList + foldl (fun current_D v => firingMove G current_D v) D S.toList + +/-- Fuel-bounded borrowing loop that seeks nonnegative wealth away from the distinguished +vertex. -/ +noncomputable def makeNonNegativeExceptQLoop (G : CFGraph) (q : G.V) (current_D : CFDiv G) (fuel + : Nat) : Option (CFDiv G) := + if _h_fuel_zero : fuel = 0 then none -- Name hypothesis + else + -- Check if any vertex v != q has D(v) < 0 + let non_q_vertices := Finset.univ.erase q + -- Use `find?` to efficiently check for a negative vertex + match non_q_vertices.toList.find? (fun v => current_D v < 0) with + | none => some current_D -- Goal reached: all v != q are non-negative + | some v => -- Found a vertex v != q with current_D v < 0 + -- Borrow at the in-debt non-source vertex and continue. + makeNonNegativeExceptQLoop G q (borrowingMove G current_D v) (fuel - 1) +termination_by fuel +decreasing_by simp_wf; exact Nat.pos_of_ne_zero _h_fuel_zero -- Simpler explicit proof /-- The preprocessing step for `findQReducedDivisor`. @@ -129,21 +156,29 @@ $v \ne q$ (Corry-Perkinson, Algorithm 4). Requires sufficient fuel for the termination guard. Returns `none` if fuel runs out, implying potential unwinnability or insufficient fuel. -/ -noncomputable def makeNonNegativeExceptQ (G : CFGraph) (q : G.V) (D : CFDiv G) (max_fuel : Nat) : Option (CFDiv G) := - let rec loop (current_D : CFDiv G) (fuel : Nat) : Option (CFDiv G) := - if _h_fuel_zero : fuel = 0 then none -- Name hypothesis +noncomputable def makeNonNegativeExceptQ (G : CFGraph) (q : G.V) (D : CFDiv G) (max_fuel : Nat) + : Option (CFDiv G) := + makeNonNegativeExceptQLoop G q D max_fuel + +/-- Fuel-bounded reduction loop that fires the nonburning set and returns the current +divisor. -/ +noncomputable def findQReducedDivisorLoop (G : CFGraph) (q : G.V) (current_D : CFDiv G) (fuel : + Nat) : CFDiv G := + if h_fuel_zero : fuel = 0 then -- Name hypothesis + -- Fuel exhausted in main findQReducedDivisorLoop G q, return current state (might not + -- be fully q-reduced) + current_D + else + -- Use current_D as the configuration function for dharBurningSet + let S := dharBurningSet G q current_D + -- If the set S is non-empty, fire it and continue looping + if hs : S.Nonempty then + findQReducedDivisorLoop G q (fireSet G current_D S) (fuel - 1) else - -- Check if any vertex v != q has D(v) < 0 - let non_q_vertices := Finset.univ.erase q - -- Use `find?` to efficiently check for a negative vertex - match non_q_vertices.toList.find? (fun v => current_D v < 0) with - | none => some current_D -- Goal reached: all v != q are non-negative - | some v => -- Found a vertex v != q with current_D v < 0 - -- Borrow at the in-debt non-source vertex and continue. - loop (borrowing_move G current_D v) (fuel - 1) - termination_by fuel - decreasing_by simp_wf; exact Nat.pos_of_ne_zero _h_fuel_zero -- Simpler explicit proof - loop D max_fuel + -- S is empty, the divisor is q-reduced + current_D +termination_by fuel +decreasing_by simp_wf; exact Nat.pos_of_ne_zero h_fuel_zero -- Simpler explicit proof /-- Finds the unique $q$-reduced divisor linearly equivalent to $D$ (Corry-Perkinson, @@ -165,24 +200,10 @@ noncomputable def findQReducedDivisor (G : CFGraph) (q : G.V) (D : CFDiv G) : Op match makeNonNegativeExceptQ G q D preprocess_fuel with | none => none -- Preprocessing failed | some D_preprocessed => - let rec loop (current_D : CFDiv G) (fuel : Nat) : CFDiv G := - if h_fuel_zero : fuel = 0 then -- Name hypothesis - -- Fuel exhausted in main loop, return current state (might not be fully q-reduced) - current_D - else - -- Use current_D as the configuration function for dharBurningSet - let S := dharBurningSet G q current_D - -- If the set S is non-empty, fire it and continue looping - if hs : S.Nonempty then - loop (fireSet G current_D S) (fuel - 1) - else - -- S is empty, the divisor is q-reduced - current_D - termination_by fuel - decreasing_by simp_wf; exact Nat.pos_of_ne_zero h_fuel_zero -- Simpler explicit proof - -- Estimate fuel for main loop from possible q-effective non-source chip vectors. + -- Estimate fuel for main findQReducedDivisorLoop G q from possible + -- q-effective non-source chip vectors. let main_loop_fuel := (nonSourceChipCount G q D_preprocessed + 1) ^ Fintype.card G.V + 1 - some (loop D_preprocessed main_loop_fuel) + some (findQReducedDivisorLoop G q D_preprocessed main_loop_fuel) /-- Simulates the fire spread from $q$ in Dhar's algorithm on a configuration $c$. @@ -216,10 +237,40 @@ noncomputable def isWinnable (G : CFGraph) (q : G.V) (D : CFDiv G) : Bool := /-- Calculates the incoming burning degree of a vertex $v$ from a set $B$. -This sums `num_edges` from each $u \in B$ to $v$. +This sums `numEdges` from each $u \in B$ to $v$. -/ -def burning_indeg (G : CFGraph) (B : Finset G.V) (v : G.V) : ℤ := - ∑ u ∈ B, (num_edges G u v : ℤ) +def burningIndeg (G : CFGraph) (B : Finset G.V) (v : G.V) : ℤ := + ∑ u ∈ B, (numEdges G u v : ℤ) + +/-- Fuel-bounded burning loop that records the orientations created as vertices burn. -/ +noncomputable def dharBurningSetWithOrientationLoop (G : CFGraph) (c : G.V → ℤ) (current_S : + Finset G.V) (current_B : Finset G.V) (current_O : Multiset (G.V × G.V)) (fuel : Nat) + : Finset G.V × Multiset (G.V × G.V) := + if h_fuel : fuel = 0 then (current_S, current_O) -- Fuel exhausted, return current state + else + -- Find vertices in S that burn in this step + let newly_burned_list := current_S.toList.filter (fun v => burningIndeg G current_B v > c v) + let newly_burned := newly_burned_list.toFinset -- Use List.toFinset + + -- If no new vertices burned, the process stabilizes + if newly_burned.card = 0 then (current_S, current_O) -- Use card = 0 check + else + -- Update S and B + let next_S := current_S.filter (fun v => v ∉ newly_burned) -- Manual set difference + let next_B := current_B ∪ newly_burned + -- Update Orientation: Add edges from current_B to newly_burned + -- Use Finset.sum for clarity and potentially better type inference + let edges_to_add : Multiset (G.V × G.V) := + Finset.sum newly_burned (fun v_new => -- Sum over newly burned vertices + Finset.sum current_B (fun u => -- For each u in the burning set + Multiset.replicate (numEdges G u v_new) (u, v_new) -- Create edges u -> v_new + ) + ) + let next_O := current_O + edges_to_add + -- Recurse + dharBurningSetWithOrientationLoop G c next_S next_B next_O (fuel - 1) +termination_by fuel +decreasing_by simp_wf; exact Nat.pos_of_ne_zero h_fuel -- Use robust termination proof /-- The orientation-based version of Dhar's algorithm (Corry-Perkinson, Algorithm 5). @@ -238,40 +289,7 @@ noncomputable def dharBurningSetWithOrientation (G : CFGraph) (q : G.V) (c : G.V let initial_S := Finset.univ.erase q let initial_B := {q} let initial_O := (∅ : Multiset (G.V × G.V)) - - let rec loop (current_S : Finset G.V) (current_B : Finset G.V) (current_O : Multiset (G.V × G.V)) (fuel : Nat) - : Finset G.V × Multiset (G.V × G.V) := - if h_fuel : fuel = 0 then (current_S, current_O) -- Fuel exhausted, return current state - else - -- Find vertices in S that burn in this step - let newly_burned_list := current_S.toList.filter (fun v => burning_indeg G current_B v > c v) - let newly_burned := newly_burned_list.toFinset -- Use List.toFinset - - -- If no new vertices burned, the process stabilizes - if newly_burned.card = 0 then (current_S, current_O) -- Use card = 0 check - else - -- Update S and B - let next_S := current_S.filter (fun v => v ∉ newly_burned) -- Manual set difference - let next_B := current_B ∪ newly_burned - - -- Update Orientation: Add edges from current_B to newly_burned - -- Use Finset.sum for clarity and potentially better type inference - let edges_to_add : Multiset (G.V × G.V) := - Finset.sum newly_burned (fun v_new => -- Sum over newly burned vertices - Finset.sum current_B (fun u => -- For each u in the burning set - Multiset.replicate (num_edges G u v_new) (u, v_new) -- Create edges u -> v_new - ) - ) - - let next_O := current_O + edges_to_add - - -- Recurse - loop next_S next_B next_O (fuel - 1) - - termination_by fuel - decreasing_by simp_wf; exact Nat.pos_of_ne_zero h_fuel -- Use robust termination proof - -- Initial call with fuel based on number of vertices - loop initial_S initial_B initial_O (Fintype.card G.V + 1) + dharBurningSetWithOrientationLoop G c initial_S initial_B initial_O (Fintype.card G.V + 1) end CF diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean index e610706568..a3e90a4be7 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean @@ -8,36 +8,40 @@ import Mathlib.Algebra.Group.Subgroup.Finite import Mathlib.Analysis.Normed.Ring.Lemmas import Mathlib.Data.Matrix.Mul - - -universe u - -open Multiset Finset - /-! ## Chip-firing graphs A *chip-firing graph* (`CFGraph`) is a loopless undirected multigraph with bundled vertex type $V(G)$, implemented as `G.V` and assumed to be finite, decidably equal, and nonempty. -Edges are stored as a multiset of ordered pairs; `num_edges G v w` counts the total edge +Edges are stored as a multiset of ordered pairs; `numEdges G v w` counts the total edge multiplicity between $v$ and $w$, including both $(v,w)$ and $(w,v)$ entries. We define the *degree* (valence) of a vertex as the sum of edge multiplicities at that vertex, and the *genus* (cyclomatic number) $g = |E| - |V(G)| + 1$, which plays a central role in the Riemann-Roch theorem for graphs. -Many main theorems in this library require connectivity; see `graph_connected`. In those cases, a +Many main theorems in this library require connectivity; see `graphConnected`. In those cases, a proof of connectivity must be provided as an additional argument. -/ + + +universe u + +open Multiset Finset + + + /-- A *chip-firing graph* is a loopless multigraph. It is not assumed connected by default, though many of our main theorems pertain to connected graphs. -/ -structure CFGraph where +structure CFGraph where + /-- Finite nonempty vertex type of the chip-firing graph. -/ V : Type u [instDecidableEq : DecidableEq V] [instFintype : Fintype V] [instNonempty : Nonempty V] + /-- Multiset of edges, allowing parallel edges but excluding loops. -/ (edges : Multiset (V × V)) (loopless : ∀ v, (v, v) ∉ edges) @@ -47,17 +51,17 @@ attribute [instance] CFGraph.instDecidableEq CFGraph.instFintype CFGraph.instNon When working with chip-firing graphs in this repository, prefer this function to the underlying multiset of edges. -/ -def num_edges (G : CFGraph) (v w : G.V) : ℕ := - Multiset.card (G.edges.filter (λ e => e = (v, w) ∨ e = (w, v))) +def numEdges (G : CFGraph) (v w : G.V) : ℕ := + Multiset.card (G.edges.filter (fun e => e = (v, w) ∨ e = (w, v))) /-- A graph is *connected* if its vertices cannot be partitioned into two nonempty sets with no edges between them. This is equivalent to saying that there is a path between any two vertices, but the partition formulation is more convenient in this repository. -/ -def graph_connected (G : CFGraph) : Prop := +def graphConnected (G : CFGraph) : Prop := ∀ S : Finset G.V, (∃ (v w : G.V), v ∈ S ∧ w ∉ S) → - (∃ v ∈ S, ∃ w ∉ S, num_edges G v w > 0) + (∃ v ∈ S, ∃ w ∉ S, numEdges G v w > 0) /-- The genus of a graph is its cyclomatic number, $|E| - |V| + 1$. -/ def genus (G : CFGraph) : ℤ := @@ -65,13 +69,13 @@ def genus (G : CFGraph) : ℤ := /-- The number of edges between two vertices is symmetric (the graph is undirected). -/ lemma num_edges_symmetric (G : CFGraph) (v w : G.V) : - num_edges G v w = num_edges G w v := by - simp only [num_edges, Or.comm] + numEdges G v w = numEdges G w v := by + simp only [numEdges, Or.comm] /-- Numerical version of *loopless*: the number of edges from a vertex to itself is zero. -/ @[simp] lemma num_edges_self_zero (G : CFGraph) (v : G.V) : - num_edges G v v = 0 := by - rw [num_edges, Multiset.card_eq_zero] + numEdges G v v = 0 := by + rw [numEdges, Multiset.card_eq_zero] refine Multiset.filter_eq_nil.mpr ?_ intro e h_inE h_eq rw [or_self] at h_eq @@ -80,8 +84,8 @@ lemma num_edges_symmetric (G : CFGraph) (v w : G.V) : exact G.loopless v h_inE /-- The degree, or valence, of a vertex as an integer. -/ -def vertex_degree (G : CFGraph) (v : G.V) : ℤ := - ∑ u : G.V, (num_edges G v u : ℤ) +def vertexDegree (G : CFGraph) (v : G.V) : ℤ := + ∑ u : G.V, (numEdges G v u : ℤ) /-! ## The divisor group @@ -94,7 +98,7 @@ of functions $V(G) \to \mathbb{Z}$ under pointwise addition. This section establishes basic operations on divisors: pointwise arithmetic lemmas, the *firing move* at a single vertex (lending chips to all neighbors), the *borrowing move* (the inverse operation), and the generalization to *set firing*. The firing vector -`firing_vector G v` is the principal divisor produced by firing vertex $v$ once. +`firingVector G v` is the principal divisor produced by firing vertex $v$ once. See: - [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.3. @@ -107,19 +111,19 @@ See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.3. -/ abbrev CFDiv (G : CFGraph) := G.V → ℤ /-- The divisor with one chip at a specified vertex $v_{\mathrm{chip}}$ and zero chips elsewhere. -/ -def one_chip {G : CFGraph} (v_chip : G.V) : CFDiv G := +def oneChip {G : CFGraph} (v_chip : G.V) : CFDiv G := fun v => if v = v_chip then 1 else 0 --- Canonical simplifications for evaluations of one_chip. -@[simp] lemma one_chip_apply_v {G : CFGraph} (v : G.V) : one_chip v v = 1 := by +-- Canonical simplifications for evaluations of oneChip. +@[simp] lemma one_chip_apply_v {G : CFGraph} (v : G.V) : oneChip v v = 1 := by exact ite_eq_left rfl -@[simp] lemma one_chip_apply_other {G : CFGraph} (v w : G.V) : v ≠ w → one_chip v w = 0 := by - simp only [ne_eq, one_chip, ite_eq_right_iff, one_ne_zero, imp_false] +@[simp] lemma one_chip_apply_other {G : CFGraph} (v w : G.V) : v ≠ w → oneChip v w = 0 := by + simp only [ne_eq, oneChip, ite_eq_right_iff, one_ne_zero, imp_false] intro h contrapose! h rw [h] -@[simp] lemma one_chip_apply_other' {G : CFGraph} (v w : G.V) : w ≠ v → one_chip v w = 0 := by - simp only [ne_eq, one_chip, ite_eq_right_iff, one_ne_zero, imp_false, imp_self] +@[simp] lemma one_chip_apply_other' {G : CFGraph} (v w : G.V) : w ≠ v → oneChip v w = 0 := by + simp only [ne_eq, oneChip, ite_eq_right_iff, one_ne_zero, imp_false, imp_self] -- Properties of divisor arithmetic (add_apply, sub_apply, zero_apply, neg_apply, smul_apply @@ -128,67 +132,67 @@ def one_chip {G : CFGraph} (v_chip : G.V) : CFDiv G := /-- The result of firing a vertex $v$, starting from the divisor $D$. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.5. -/ -def firing_move (G : CFGraph) (D : CFDiv G) (v : G.V) : CFDiv G := - λ w => if w = v then D v - vertex_degree G v else D w + num_edges G v w +def firingMove (G : CFGraph) (D : CFDiv G) (v : G.V) : CFDiv G := + fun w => if w = v then D v - vertexDegree G v else D w + numEdges G v w /-- The result of borrowing at a vertex $v$, starting from a divisor $D$. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.5. -/ -def borrowing_move (G : CFGraph) (D : CFDiv G) (v : G.V) : CFDiv G := - λ w => if w = v then D v + vertex_degree G v else D w - num_edges G v w +def borrowingMove (G : CFGraph) (D : CFDiv G) (v : G.V) : CFDiv G := + fun w => if w = v then D v + vertexDegree G v else D w - numEdges G v w /-- The out-degree of `v` relative to `S`, counted with edge multiplicity. -/ -def outdeg_S (G : CFGraph) (S : Finset G.V) (v : G.V) : ℤ := - ∑ w ∈ (univ \ S), (num_edges G v w : ℤ) +def outdegS (G : CFGraph) (S : Finset G.V) (v : G.V) : ℤ := + ∑ w ∈ (univ \ S), (numEdges G v w : ℤ) @[simp] theorem outdeg_S_eq_sum_filter (G : CFGraph) (S : Finset G.V) (v : G.V) : - outdeg_S G S v = ∑ w ∈ Finset.univ.filter (fun x => x ∉ S), - (num_edges G v w : ℤ) := by + outdegS G S v = ∑ w ∈ Finset.univ.filter (fun x => x ∉ S), + (numEdges G v w : ℤ) := by refine Finset.sum_congr ?_ (fun _ _ => rfl) ext w simp theorem outdeg_S_nonneg (G : CFGraph) (S : Finset G.V) (v : G.V) : - 0 ≤ outdeg_S G S v := by - unfold outdeg_S + 0 ≤ outdegS G S v := by + unfold outdegS exact Finset.sum_nonneg fun _ _ => Int.natCast_nonneg _ theorem outdeg_S_antitone (G : CFGraph) {S T : Finset G.V} (h : S ⊆ T) (v : G.V) : - outdeg_S G T v ≤ outdeg_S G S v := by - unfold outdeg_S + outdegS G T v ≤ outdegS G S v := by + unfold outdegS exact Finset.sum_le_sum_of_subset_of_nonneg (Finset.compl_subset_compl.mpr h) (fun _ _ _ => Int.natCast_nonneg _) /-- The result of firing a set $S$ of vertices, starting from a divisor $D$. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.6. -/ -def set_firing (G : CFGraph) (D : CFDiv G) (S : Finset G.V) : CFDiv G := - λ w => if w ∈ S then D w - outdeg_S G S w else D w + outdeg_S G Sᶜ w +def setFiring (G : CFGraph) (D : CFDiv G) (S : Finset G.V) : CFDiv G := + fun w => if w ∈ S then D w - outdegS G S w else D w + outdegS G Sᶜ w theorem set_firing_apply_of_mem (G : CFGraph) (D : CFDiv G) {S : Finset G.V} {v : G.V} (hv : v ∈ S) : - set_firing G D S v = D v - outdeg_S G S v := by - simp [set_firing, hv] + setFiring G D S v = D v - outdegS G S v := by + simp [setFiring, hv] theorem set_firing_apply_of_not_mem (G : CFGraph) (D : CFDiv G) {S : Finset G.V} {v : G.V} (hv : v ∉ S) : - set_firing G D S v = D v + outdeg_S G Sᶜ v := by - simp [set_firing, hv] + setFiring G D S v = D v + outdegS G Sᶜ v := by + simp [setFiring, hv] theorem le_set_firing_apply_of_not_mem (G : CFGraph) (D : CFDiv G) {S : Finset G.V} {v : G.V} (hv : v ∉ S) : - D v ≤ set_firing G D S v := by + D v ≤ setFiring G D S v := by rw [set_firing_apply_of_not_mem G D hv] exact le_add_of_nonneg_right (outdeg_S_nonneg G Sᶜ v) /-- The principal divisor associated to firing a single vertex. -/ -def firing_vector (G : CFGraph) (v : G.V) : CFDiv G := - λ w => if w = v then -vertex_degree G v else num_edges G v w +def firingVector (G : CFGraph) (v : G.V) : CFDiv G := + fun w => if w = v then -vertexDegree G v else numEdges G v w /-! ## Principal divisors and linear equivalence -A *firing script* (`firing_script G = G.V → ℤ`) assigns an integer firing level to each vertex. +A *firing script* (`firingScript G = G.V → ℤ`) assigns an integer firing level to each vertex. The associated *principal divisor* `prin G σ` records the net chip flow at each vertex when the script $\sigma$ is applied: $$ @@ -196,60 +200,60 @@ $$ \sum_u (\sigma(u)-\sigma(v)) \operatorname{num\_edges}_G(v,u). $$ -The subgroup of *principal divisors* `principal_divisors G` is generated by the firing vectors -`firing_vector G v` for all $v$. Two divisors $D$ and $D'$ are *linearly equivalent* -(`linear_equiv G D D'`) if their difference is a principal divisor. This defines an +The subgroup of *principal divisors* `principalDivisors G` is generated by the firing vectors +`firingVector G v` for all $v$. Two divisors $D$ and $D'$ are *linearly equivalent* +(`linearEquiv G D D'`) if their difference is a principal divisor. This defines an equivalence relation on $\operatorname{Div}(G)$, and linearly equivalent divisors have the same degree (see `linear_equiv_preserves_deg`). -/ /-- The subgroup of principal divisors is generated by firing vectors at individual vertices. -/ -def principal_divisors (G : CFGraph) : AddSubgroup (CFDiv G) := - AddSubgroup.closure (Set.range (firing_vector G)) +def principalDivisors (G : CFGraph) : AddSubgroup (CFDiv G) := + AddSubgroup.closure (Set.range (firingVector G)) /-- Two divisors are *linearly equivalent* if their difference is a principal divisor. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.8. -/ -def linear_equiv (G : CFGraph) (D D' : CFDiv G) : Prop := - D' - D ∈ principal_divisors G +def linearEquiv (G : CFGraph) (D D' : CFDiv G) : Prop := + D' - D ∈ principalDivisors G /-- Principal divisors contain the firing vector at a vertex. -/ private lemma mem_principal_divisors_firing_vector (G : CFGraph) (v : G.V) : - firing_vector G v ∈ principal_divisors G := AddSubgroup.subset_closure (Set.mem_range_self v) + firingVector G v ∈ principalDivisors G := AddSubgroup.subset_closure (Set.mem_range_self v) /-- Linear equivalence is reflexive. -/ -@[refl] lemma linear_equiv.refl (G : CFGraph) (D : CFDiv G) : linear_equiv G D D := by - unfold linear_equiv +@[refl] lemma linearEquiv.refl (G : CFGraph) (D : CFDiv G) : linearEquiv G D D := by + unfold linearEquiv simp only [sub_self, zero_mem] /-- Linear equivalence is symmetric. -/ -@[symm] lemma linear_equiv.symm {G : CFGraph} {D D' : CFDiv G} : - linear_equiv G D D' → linear_equiv G D' D := by +@[symm] lemma linearEquiv.symm {G : CFGraph} {D D' : CFDiv G} : + linearEquiv G D D' → linearEquiv G D' D := by intro h - unfold linear_equiv at * + unfold linearEquiv at * simpa only [sub_eq_add_neg, neg_add_rev, neg_neg] - using AddSubgroup.neg_mem (principal_divisors G) h + using AddSubgroup.neg_mem (principalDivisors G) h /-- Linear equivalence is transitive. -/ -@[trans] lemma linear_equiv.trans {G : CFGraph} {D₁ D₂ D₃ : CFDiv G} : - linear_equiv G D₁ D₂ → linear_equiv G D₂ D₃ → linear_equiv G D₁ D₃ := by +@[trans] lemma linearEquiv.trans {G : CFGraph} {D₁ D₂ D₃ : CFDiv G} : + linearEquiv G D₁ D₂ → linearEquiv G D₂ D₃ → linearEquiv G D₁ D₃ := by intro h1 h2 - unfold linear_equiv at * + unfold linearEquiv at * simpa only [sub_eq_add_neg, add_comm, add_left_comm, add_assoc, add_neg_cancel_comm_assoc] using - AddSubgroup.add_mem (principal_divisors G) h2 h1 + AddSubgroup.add_mem (principalDivisors G) h2 h1 /-- Linear equivalence is an equivalence relation on $\operatorname{Div}(G)$. -/ -theorem linear_equiv_is_equivalence (G : CFGraph) : Equivalence (linear_equiv G) := - ⟨linear_equiv.refl G, linear_equiv.symm, linear_equiv.trans⟩ +theorem linear_equiv_is_equivalence (G : CFGraph) : Equivalence (linearEquiv G) := + ⟨linearEquiv.refl G, linearEquiv.symm, linearEquiv.trans⟩ /-- A *firing script* is an integer-valued function on vertices, recording how many times each vertex is fired. Negative values represent borrowing. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 2.2. -/ -abbrev firing_script (G : CFGraph) := G.V → ℤ +abbrev firingScript (G : CFGraph) := G.V → ℤ /-- The firing script that fires exactly the vertices in `S`, once each. -/ -def indicator_script (G : CFGraph) (S : Finset G.V) : firing_script G := +def indicatorScript (G : CFGraph) (S : Finset G.V) : firingScript G := fun v => if v ∈ S then 1 else 0 /-- The group homomorphism sending a firing script $\sigma$ to the principal divisor @@ -261,9 +265,9 @@ $$ See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 2.3; `prin G σ` is the *negative* of the divisor $\operatorname{div}(\sigma)$ defined there, since they implement a firing script as $D \mapsto D - \operatorname{div}(\sigma)$. -/ -def prin (G : CFGraph) : firing_script G →+ CFDiv G := +def prin (G : CFGraph) : firingScript G →+ CFDiv G := { - toFun := fun σ v => ∑ u : G.V, (σ u - σ v) * (num_edges G v u), + toFun := fun σ v => ∑ u : G.V, (σ u - σ v) * (numEdges G v u), map_zero' := by funext v simp only [Pi.zero_apply, sub_self, zero_mul, sum_const_zero], @@ -277,8 +281,8 @@ def prin (G : CFGraph) : firing_script G →+ CFDiv G := ring, } -@[simp] theorem prin_apply (G : CFGraph) (σ : firing_script G) (v : G.V) : - prin G σ v = ∑ u : G.V, (σ u - σ v) * (num_edges G v u : ℤ) := rfl +@[simp] theorem prin_apply (G : CFGraph) (σ : firingScript G) (v : G.V) : + prin G σ v = ∑ u : G.V, (σ u - σ v) * (numEdges G v u : ℤ) := rfl /-- Constant firing scripts have zero principal divisor. -/ @[simp] theorem prin_const (G : CFGraph) (c : ℤ) : @@ -287,7 +291,7 @@ def prin (G : CFGraph) : firing_script G →+ CFDiv G := rw [prin_apply] simp -@[simp] theorem prin_sub_const (G : CFGraph) (σ : firing_script G) (c : ℤ) : +@[simp] theorem prin_sub_const (G : CFGraph) (σ : firingScript G) (c : ℤ) : prin G (fun v => σ v - c) = prin G σ := by funext v rw [prin_apply, prin_apply] @@ -298,72 +302,73 @@ def prin (G : CFGraph) : firing_script G →+ CFDiv G := /-- Firing a set once is the same as adding the principal divisor of its indicator script. -/ theorem set_firing_eq_add_prin_indicator_script (G : CFGraph) (D : CFDiv G) (S : Finset G.V) : - set_firing G D S = D + prin G (indicator_script G S) := by + setFiring G D S = D + prin G (indicatorScript G S) := by classical funext v by_cases hv : v ∈ S - · simp [set_firing, indicator_script, prin_apply, outdeg_S, hv] + · simp only [setFiring, hv, ↓reduceIte, outdegS, subset_univ, sum_sdiff_eq_sub, + Pi.add_apply, prin_apply, indicatorScript] simp only [sub_mul, one_mul] rw [Finset.sum_sub_distrib] - have hs : S.sum (fun x => (num_edges G v x : ℤ)) = + have hs : S.sum (fun x => (numEdges G v x : ℤ)) = (univ : Finset G.V).sum (fun x => - (if x ∈ S then 1 else 0) * (num_edges G v x : ℤ)) := by simp + (if x ∈ S then 1 else 0) * (numEdges G v x : ℤ)) := by simp rw [← hs] ring - · simp [set_firing, indicator_script, prin_apply, outdeg_S, hv] + · simp [setFiring, indicatorScript, prin_apply, outdegS, hv] /-- A divisor is principal if and only if it equals `prin G σ` for some firing script `σ`. -This gives a concrete characterization of the subgroup `principal_divisors G`. -/ +This gives a concrete characterization of the subgroup `principalDivisors G`. -/ lemma principal_iff_eq_prin (G : CFGraph) (D : CFDiv G) : - D ∈ principal_divisors G ↔ ∃ σ : firing_script G, D = prin G σ := by - unfold principal_divisors + D ∈ principalDivisors G ↔ ∃ σ : firingScript G, D = prin G σ := by + unfold principalDivisors constructor · -- Forward direction intro h_inp -- Use the defining property of a subgroup closure refine AddSubgroup.closure_induction ?_ ?_ ?_ ?_ h_inp - . -- Case 1: h_inp is a firing vector + · -- Case 1: h_inp is a firing vector intro x h_firing rcases h_firing with ⟨v, rfl⟩ - let σ : firing_script G := λ u => if u = v then 1 else 0 + let σ : firingScript G := fun u => if u = v then 1 else 0 use σ - unfold firing_vector prin + unfold firingVector prin funext w dsimp only [AddMonoidHom.coe_mk, ZeroHom.coe_mk, σ] by_cases h_eq : w = v - . -- Case w = v + · -- Case w = v simp only [h_eq, ↓reduceIte] - unfold vertex_degree + unfold vertexDegree rw [← Finset.sum_neg_distrib] apply Finset.sum_congr rfl intro u _ by_cases h_eq2 : u = v <;> simp only [h_eq2, num_edges_self_zero, CharP.cast_eq_zero, neg_zero, ↓reduceIte, sub_self, mul_zero, zero_sub, Int.reduceNeg, neg_mul, one_mul] - . -- Case w ≠ v + · -- Case w ≠ v simp only [h_eq, ↓reduceIte, num_edges_symmetric G v w, sub_zero, ite_mul, one_mul, zero_mul, sum_ite_eq', mem_univ] - . -- Case 2: h_inp is zero divisor + · -- Case 2: h_inp is zero divisor use 0 simp only [_root_.map_zero] - . -- Case 3: h_inp is a sum of two principal divisors + · -- Case 3: h_inp is a sum of two principal divisors intros x y _ _ h_x_prin h_y_prin rcases h_x_prin with ⟨σ₁, h_x_eq⟩ rcases h_y_prin with ⟨σ₂, h_y_eq⟩ rw [h_x_eq, h_y_eq] use σ₁ + σ₂ simp only [_root_.map_add] - . -- Case 4: h_inp is negation of a principal divisor + · -- Case 4: h_inp is negation of a principal divisor intro x _ h_x_prin rcases h_x_prin with ⟨σ, h_x_eq⟩ use -σ rw [h_x_eq] simp only [map_neg] - . -- Backward direction + · -- Backward direction intro h_prin rcases h_prin with ⟨σ, h_eq⟩ unfold prin at h_eq - let D₁ := ∑ u : G.V, (σ u) • (firing_vector G u) - have D1_principal :D₁ ∈ principal_divisors G := by + let D₁ := ∑ u : G.V, (σ u) • (firingVector G u) + have D1_principal :D₁ ∈ principalDivisors G := by apply AddSubgroup.sum_mem _ _ intro u _ apply AddSubgroup.zsmul_mem _ _ @@ -373,24 +378,24 @@ lemma principal_iff_eq_prin (G : CFGraph) (D : CFDiv G) : funext v -- expand the definition of D₁ dsimp only [AddMonoidHom.coe_mk, ZeroHom.coe_mk, D₁] - unfold firing_vector + unfold firingVector -- Move that v into the sum on the left side simp only [Finset.sum_apply] simp only [Pi.smul_apply, Int.zsmul_eq_mul, mul_ite, mul_neg] - have: ∀ (u : G.V), (σ u - σ v) * ↑(num_edges G v u) = σ u * ↑(num_edges G v u) - σ v * ↑(num_edges G v u) := by intro u; ring + have: ∀ (u : G.V), (σ u - σ v) * ↑(numEdges G v u) = σ u * ↑(numEdges G v u) - σ v * + ↑(numEdges G v u) := by intro u; ring simp only [this] - - have h (x : G.V) : (if v = x then -(σ x * vertex_degree G x) else σ x * ↑(num_edges G x v) ) = σ x * (↑(num_edges G x v) ) - σ x * ( (if v = x then vertex_degree G x else 0)) := by + have h (x : G.V) : (if v = x then -(σ x * vertexDegree G x) else σ x * ↑(numEdges G x v) ) + = σ x * (↑(numEdges G x v) ) - σ x * ( (if v = x then vertexDegree G x else 0)) := by by_cases h : v = x <;> simp only [h, ↓reduceIte, mul_zero, sub_zero, num_edges_self_zero, CharP.cast_eq_zero, zero_sub] - simp only [h] rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib] - suffices ∑ x : G.V, σ x * (if v = x then vertex_degree G x else 0) = ∑ x : G.V, (σ v * ↑(num_edges G v x)) by + suffices ∑ x : G.V, σ x * (if v = x then vertexDegree G x else 0) = ∑ x : G.V, (σ v * + ↑(numEdges G v x)) by rw [this] simp only [num_edges_symmetric] - - dsimp only [vertex_degree] + dsimp only [vertexDegree] rw [← Finset.mul_sum] simp only [mul_ite, mul_zero, sum_ite_eq, mem_univ, ↓reduceIte] rw [← D_eq] @@ -428,9 +433,9 @@ def Eff (G : CFGraph) : AddSubmonoid (CFDiv G) := @[simp] lemma mem_Eff {G : CFGraph} {D : CFDiv G} : D ∈ Eff G ↔ effective D := Iff.rfl /-- A one-chip divisor is effective. -/ -lemma eff_one_chip {G : CFGraph} (v : G.V) : effective (one_chip v) := by +lemma eff_one_chip {G : CFGraph} (v : G.V) : effective (oneChip v) := by intro w - dsimp only [one_chip] + dsimp only [oneChip] by_cases h_eq : w = v <;> simp only [h_eq, ↓reduceIte, ge_iff_le, Std.le_refl, zero_le_one] /-- The divisor $D_1-D_2$ is effective if and only if $D_1 \ge D_2$. -/ @@ -441,7 +446,7 @@ lemma sub_eff_iff_geq {G : CFGraph} (D₁ D₂ : CFDiv G) : effective (D₁ - D See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.14. -/ def winnable (G : CFGraph) (D : CFDiv G) : Prop := - ∃ D' ∈ Eff G, linear_equiv G D D' + ∃ D' ∈ Eff G, linearEquiv G D D' /-! @@ -451,7 +456,7 @@ The *degree* of a divisor $D$ is $\deg(D) = \sum_v D(v)$, the total number of ch It is a group homomorphism $\mathrm{Div}(G) \to \mathbb{Z}$. Principal divisors have degree zero, so linearly equivalent divisors have equal degree. -The *Laplacian matrix* `laplacian_matrix G` is the matrix $L = \mathrm{Deg}(G) - A$, where +The *Laplacian matrix* `laplacianMatrix G` is the matrix $L = \mathrm{Deg}(G) - A$, where $\mathrm{Deg}(G)$ is the diagonal degree matrix and $A$ is the adjacency matrix. Applying the Laplacian to a firing script produces the corresponding principal divisor. -/ @@ -460,7 +465,7 @@ Applying the Laplacian to a firing script produces the corresponding principal d See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 1.4. -/ def deg {G : CFGraph} : CFDiv G →+ ℤ := { - toFun := λ D => ∑ v, D v, + toFun := fun D => ∑ v, D v, map_zero' := by simp only [Pi.zero_apply, sum_const_zero], map_add' := by @@ -468,8 +473,8 @@ def deg {G : CFGraph} : CFDiv G →+ ℤ := { simp only [Pi.add_apply, sum_add_distrib], } -@[simp] lemma deg_one_chip {G : CFGraph} (v : G.V) : deg (one_chip v) = 1 := by - simp only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk, one_chip, sum_ite_eq', mem_univ, ↓reduceIte] +@[simp] lemma deg_one_chip {G : CFGraph} (v : G.V) : deg (oneChip v) = 1 := by + simp only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk, oneChip, sum_ite_eq', mem_univ, ↓reduceIte] /-- Effective divisors have nonnegative degree. -/ lemma deg_of_eff_nonneg (D : CFDiv G) : @@ -486,22 +491,23 @@ lemma eff_degree_zero (D : CFDiv G) : effective D → deg D = 0 → D = 0 := by /-- The degree of a firing vector is zero. -/ private lemma deg_firing_vector_eq_zero (G : CFGraph) (v_fire : G.V) : - deg (firing_vector G v_fire) = 0 := by - dsimp only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk, firing_vector] + deg (firingVector G v_fire) = 0 := by + dsimp only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk, firingVector] rw [Finset.sum_ite] have h_filter_eq_single : Finset.filter (fun x => x = v_fire) univ = {v_fire} := by ext x; simp only [eq_comm, Finset.mem_filter, mem_univ, true_and, Finset.mem_singleton] rw [h_filter_eq_single, Finset.sum_singleton] - have h_filter_eq_erase : Finset.filter (fun x => ¬x = v_fire) univ = Finset.univ.erase v_fire := by + have h_filter_eq_erase : Finset.filter (fun x => ¬x = v_fire) univ = Finset.univ.erase v_fire + := by ext x simp only [Finset.mem_filter, mem_univ, true_and, mem_erase, and_true] rw [h_filter_eq_erase] - simp only [vertex_degree, mem_univ, sum_erase_eq_sub, num_edges_self_zero, CharP.cast_eq_zero, + simp only [vertexDegree, mem_univ, sum_erase_eq_sub, num_edges_self_zero, CharP.cast_eq_zero, sub_zero, neg_add_cancel] /-- Every principal divisor has degree zero. -/ private lemma degree_of_principal_divisor_is_zero (G : CFGraph) (h : CFDiv G) : - h ∈ principal_divisors G → deg h = 0 := by + h ∈ principalDivisors G → deg h = 0 := by intro h_mem_princ refine AddSubgroup.closure_induction ?_ ?_ ?_ ?_ h_mem_princ · rintro x ⟨v, rfl⟩ @@ -515,9 +521,9 @@ private lemma degree_of_principal_divisor_is_zero (G : CFGraph) (h : CFDiv G) : /-- Linearly equivalent divisors have the same degree. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Proposition 1.15. -/ -theorem linear_equiv_preserves_deg (G : CFGraph) (D D' : CFDiv G) (h_equiv : linear_equiv G D D') : +theorem linear_equiv_preserves_deg (G : CFGraph) (D D' : CFDiv G) (h_equiv : linearEquiv G D D') : deg D = deg D' := by - unfold linear_equiv at h_equiv + unfold linearEquiv at h_equiv apply degree_of_principal_divisor_is_zero at h_equiv rw [map_sub] at h_equiv linarith @@ -530,41 +536,38 @@ lemma effective_divisor_decomposition (G : CFGraph) (E'' : CFDiv G) (k₁ k₂ : effective E₁ ∧ effective E₂ ∧ deg E₁ = k₁ ∧ deg E₂ = k₂ ∧ E'' = E₁ + E₂ := by - let can_split (E : CFDiv G) (a b : ℕ): Prop := ∃ (E₁ E₂ : CFDiv G), effective E₁ ∧ effective E₂ ∧ deg E₁ = a ∧ deg E₂ = b ∧ E = E₁ + E₂ - let P (a b : ℕ) : Prop := ∀ (E : CFDiv G), effective E → deg E = a + b → can_split E a b - have h_ind (a b : ℕ): P a b := by induction a with | zero => - . -- Base case: a = 0 + · -- Base case: a = 0 intro E h_eff h_deg use (0 : CFDiv G), E constructor -- E₁ is effective - dsimp only [effective, Pi.zero_apply] - intro v - linarith + · dsimp only [effective, Pi.zero_apply] + intro v + linarith -- E₂ is effective constructor - exact h_eff + · exact h_eff -- deg E₁ = 0 constructor - simp only [_root_.map_zero, CharP.cast_eq_zero] + · simp only [_root_.map_zero, CharP.cast_eq_zero] -- deg E₂ = b constructor - rw[h_deg] - simp only [CharP.cast_eq_zero, zero_add] + · rw[h_deg] + simp only [CharP.cast_eq_zero, zero_add] -- E = 0 + E simp only [zero_add] | succ a ha => - . -- Inductive step: assume P a b holds, prove P (a+1) b + · -- Inductive step: assume P a b holds, prove P (a+1) b dsimp only [Int.natCast_add, Int.cast_ofNat_Int, P] at * intro E E_effective E_deg have ex_v : ∃ (v : G.V), E v ≥ 1 := by @@ -580,18 +583,18 @@ lemma effective_divisor_decomposition (G : CFGraph) (E'' : CFDiv G) (k₁ k₂ : rw [h_sum] at E_deg linarith rcases ex_v with ⟨v, hv_ge_one⟩ - let E' := E - one_chip v + let E' := E - oneChip v have h_E'_effective : effective E' := by intro w dsimp only [Pi.sub_apply, E'] by_cases hw : w = v · rw [hw] specialize hv_ge_one - dsimp only [one_chip] + dsimp only [oneChip] simp only [↓reduceIte, Int.sub_nonneg] linarith · specialize E_effective w - dsimp only [one_chip] + dsimp only [oneChip] simp only [hw, ↓reduceIte, sub_zero, ge_iff_le] linarith specialize ha E' h_E'_effective @@ -599,34 +602,33 @@ lemma effective_divisor_decomposition (G : CFGraph) (E'' : CFDiv G) (k₁ k₂ : dsimp only [E']; simp only [map_sub, deg_one_chip]; omega apply ha at h_deg_E' rcases h_deg_E' with ⟨E₁, E₂, h_E1_eff, h_E2_eff, h_deg_E1, h_deg_E2, h_eq_split⟩ - use E₁ + one_chip v, E₂ - -- Check E₁ + one_chip v is effective + use E₁ + oneChip v, E₂ + -- Check E₁ + oneChip v is effective constructor - apply (Eff G).add_mem - -- E₁ is effective - exact h_E1_eff - -- one_chip v is effective - intro w - dsimp only [one_chip] - simp only [ge_iff_le] - by_cases hw : w = v - rw [hw] - simp only [↓reduceIte, zero_le_one] - simp only [hw, ↓reduceIte, Std.le_refl] + · apply (Eff G).add_mem + -- E₁ is effective + · exact h_E1_eff + -- oneChip v is effective + intro w + dsimp only [oneChip] + simp only [ge_iff_le] + by_cases hw : w = v + · rw [hw] + simp only [↓reduceIte, zero_le_one] + simp only [hw, ↓reduceIte, Std.le_refl] -- E₂ is effective constructor - exact h_E2_eff - -- deg (E₁ + one_chip v) = a + 1 + · exact h_E2_eff + -- deg (E₁ + oneChip v) = a + 1 constructor - simp only [_root_.map_add, h_deg_E1, deg_one_chip, Nat.cast_add, Nat.cast_one] + · simp only [_root_.map_add, h_deg_E1, deg_one_chip, Nat.cast_add, Nat.cast_one] -- deg E₂ = b constructor - exact h_deg_E2 - -- E = (E₁ + one_chip v) + E₂ + · exact h_deg_E2 + -- E = (E₁ + oneChip v) + E₂ dsimp only [E'] at h_eq_split - rw [add_assoc, add_comm (one_chip v), ← add_assoc, ← h_eq_split] + rw [add_assoc, add_comm (oneChip v), ← add_assoc, ← h_eq_split] abel - exact h_ind k₁ k₂ E'' h_effective h_deg open Matrix @@ -634,8 +636,8 @@ open Matrix /-- The Laplacian matrix of a CFGraph. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 2.6. -/ -def laplacian_matrix (G : CFGraph) : Matrix G.V G.V ℤ := - λ i j => if i = j then vertex_degree G i else - (num_edges G i j) +def laplacianMatrix (G : CFGraph) : Matrix G.V G.V ℤ := + fun i j => if i = j then vertexDegree G i else - (numEdges G i j) -- Note: The Laplacian matrix L is given by Deg(G) - A, where Deg(G) is the diagonal -- matrix of degrees and A is the adjacency matrix. @@ -643,14 +645,14 @@ def laplacian_matrix (G : CFGraph) : Matrix G.V G.V ℤ := /-- Applies the Laplacian matrix to a firing script and a current divisor to obtain a new divisor. -/ -def apply_laplacian (G : CFGraph) (σ : firing_script G) (D: CFDiv G) : CFDiv G := - fun v => (D v) - (laplacian_matrix G).mulVec σ v +def applyLaplacian (G : CFGraph) (σ : firingScript G) (D : CFDiv G) : CFDiv G := + fun v => (D v) - (laplacianMatrix G).mulVec σ v /-! ## q-effective divisors Fix a vertex $q$. A divisor $D$ is *$q$-effective* if $D(v) \geq 0$ for all $v \neq q$; -it may have an arbitrary (possibly negative) value at $q$ itself. The structure `q_eff_div` +it may have an arbitrary (possibly negative) value at $q$ itself. The structure `qEffDiv` packages such a divisor with its proof of $q$-effectivity. A key fact for connected graphs is that every divisor is linearly equivalent to a @@ -661,19 +663,21 @@ debt concentrated on $S$ via firing moves. /-- A divisor is *$q$-effective* if it has a nonnegative number of chips at every vertex except possibly $q$. -/ -def q_effective {G : CFGraph} (q : G.V) (D : CFDiv G) : Prop := +def qEffective {G : CFGraph} (q : G.V) (D : CFDiv G) : Prop := ∀ v : G.V, v ≠ q → D v ≥ 0 /-- A divisor bundled with a proof that it is $q$-effective. -/ -structure q_eff_div (G : CFGraph) (q : G.V) where - (D : CFDiv G) (h_eff : q_effective q D) +structure qEffDiv (G : CFGraph) (q : G.V) where + /-- Underlying divisor, nonnegative away from the distinguished vertex. -/ + (D : CFDiv G) (h_eff : qEffective q D) /-- A set of vertices is benevolent if it is possible to concentrate all debt on this set. -/ def benevolent (G : CFGraph) (S : Finset G.V) : Prop := - ∀ (D : CFDiv G), ∃ (E : CFDiv G), linear_equiv G D E ∧ (∀ (v : G.V), E v < 0 → v ∈ S) + ∀ (D : CFDiv G), ∃ (E : CFDiv G), linearEquiv G D E ∧ (∀ (v : G.V), E v < 0 → v ∈ S) /-- In a connected graph, any nonempty set is benevolent. -/ -lemma benevolent_of_nonempty {G : CFGraph} (h_conn : graph_connected G) (S : Finset G.V) (h_nonempty : S.Nonempty) : +lemma benevolent_of_nonempty {G : CFGraph} (h_conn : graphConnected G) (S : Finset G.V) + (h_nonempty : S.Nonempty) : benevolent G S := by by_cases h : S = Finset.univ · -- Case: S = G.V @@ -681,14 +685,14 @@ lemma benevolent_of_nonempty {G : CFGraph} (h_conn : graph_connected G) (S : Fin use D -- Verify the first part of the conjunction constructor - exact linear_equiv.refl G D + · exact linearEquiv.refl G D -- Verify second part intro v h_neg rw [h] simp only [mem_univ] · -- Case: S ≠ G.V let h_conn' := h_conn -- Unsimplified copy for later - dsimp only [graph_connected] at h_conn + dsimp only [graphConnected] at h_conn specialize h_conn S have : ∃ (v w : G.V), v ∈ S ∧ w ∉ S := by let v := Classical.choose h_nonempty @@ -714,15 +718,15 @@ lemma benevolent_of_nonempty {G : CFGraph} (h_conn : graph_connected G) (S : Fin specialize ih D rcases ih with ⟨E1, h_lequiv_1, h_eff_S⟩ -- Now need to adjust E1 to get E - have : ∃ E : CFDiv G, linear_equiv G E1 E ∧ (∀ v : G.V, E v < 0 → v ∈ S) := by - let fire := firing_vector G v - have p_f : fire ∈ principal_divisors G := mem_principal_divisors_firing_vector G v + have : ∃ E : CFDiv G, linearEquiv G E1 E ∧ (∀ v : G.V, E v < 0 → v ∈ S) := by + let fire := firingVector G v + have p_f : fire ∈ principalDivisors G := mem_principal_divisors_firing_vector G v let k := max 0 (-(E1 w)) let E := E1 + k • fire use E constructor · -- Verify linear equivalence - unfold linear_equiv + unfold linearEquiv have h_diff : E - E1 = k • fire := by simp only [zsmul_eq_mul, add_sub_cancel_left, E] rw [h_diff] @@ -737,7 +741,7 @@ lemma benevolent_of_nonempty {G : CFGraph} (h_conn : graph_connected G) (S : Fin contrapose! h_E_neg simp only [k] by_cases h : -(E1 w) ≥ 0 - . -- Case : E1 w nonpositive + · -- Case : E1 w nonpositive have : max 0 (-(E1 w)) = -(E1 w) := by simp only [sup_eq_right, Int.neg_nonneg]; linarith rw [this] @@ -745,20 +749,20 @@ lemma benevolent_of_nonempty {G : CFGraph} (h_conn : graph_connected G) (S : Fin rw [this] apply mul_nonneg h -- Goal: fire w -1 ≥ 0 - dsimp only [firing_vector, fire] + dsimp only [firingVector, fire] have : ¬ (w = v) := by contrapose! h_w rw [← h_w] at h_v exact h_v simp only [this, ↓reduceIte, Int.sub_nonneg, Nat.one_le_cast, ge_iff_le] linarith [h_edge] - . -- Case : E1 w positive + · -- Case : E1 w positive push Not at h dsimp only [max, Int.neg_nonneg] split_ifs at * with hle · linarith · simp only [zero_mul, add_zero] at *; linarith - . -- Case : x ≠ w + · -- Case : x ≠ w have h_T := h_eff_S x by_contra! x_nin_S have h_xT : x ∉ T := by @@ -776,10 +780,10 @@ lemma benevolent_of_nonempty {G : CFGraph} (h_conn : graph_connected G) (S : Fin -- Goal : 0 ≤ k * fire x apply mul_nonneg -- Show 0 ≤ k - dsimp only [k] - simp only [le_sup_left] + · dsimp only [k] + simp only [le_sup_left] -- Show 0 ≤ fire x - dsimp only [firing_vector, fire] + dsimp only [firingVector, fire] have : ¬ (x = v) := by contrapose! x_nin_S with x_eq_v rw [x_eq_v] @@ -806,11 +810,11 @@ decreasing_by /-- In a connected graph, every divisor is linearly equivalent to a $q$-effective divisor. Equivalently, every divisor can have all of its debt concentrated at $q$. -/ -theorem q_effective_exists {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : - ∃ (E : CFDiv G), q_effective q E ∧ linear_equiv G D E := by +theorem q_effective_exists {G : CFGraph} (h_conn : graphConnected G) (q : G.V) (D : CFDiv G) : + ∃ (E : CFDiv G), qEffective q E ∧ linearEquiv G D E := by have h_bene := benevolent_of_nonempty h_conn {q} (by use q; simp only [Finset.mem_singleton]) D rcases h_bene with ⟨E,h_equiv, h_eff⟩ - have : q_effective q E := by + have : qEffective q E := by intro v v_ne_q specialize h_eff v contrapose! h_eff @@ -824,7 +828,7 @@ theorem q_effective_exists {G : CFGraph} (h_conn : graph_connected G) (q : G.V) A firing script $\sigma$ is a *$q$-reducer* if $\sigma(q) \leq \sigma(v)$ for all $v$, meaning $q$ is fired the least (or not at all relative to the others). The relation -`reduces_to G q D₁ D₂` holds when $D_2$ is obtained from $D_1$ by applying a $q$-reducer +`reducesTo G q D₁ D₂` holds when $D_2$ is obtained from $D_1$ by applying a $q$-reducer script, i.e. $D_2 = D_1 + \mathrm{prin}(\sigma)$ for some $q$-reducer $\sigma$. This relation is reflexive and transitive, and in connected graphs it is also antisymmetric @@ -840,57 +844,56 @@ $q$-reducer in both directions has zero principal divisor /-- A firing script $\sigma$ is a *$q$-reducer* if $q$ is fired the minimum number of times: $\sigma(q) \le \sigma(v)$ for all vertices $v$. -/ -def q_reducer (G : CFGraph) (q : G.V) (σ : firing_script G) : Prop := +def qReducer (G : CFGraph) (q : G.V) (σ : firingScript G) : Prop := ∀ v : G.V, σ q ≤ σ v -/-- The relation `reduces_to G q D₁ D₂` holds when $D_2$ is obtained from $D_1$ by +/-- The relation `reducesTo G q D₁ D₂` holds when $D_2$ is obtained from $D_1$ by applying a $q$-reducer script: $$ D_2 = D_1 + \operatorname{prin}_G(\sigma) $$ for some $\sigma$ with $\sigma(q) \le \sigma(v)$ for all vertices $v$. -/ -def reduces_to (G : CFGraph) (q : G.V) (D₁ D₂: CFDiv G) : Prop := - ∃ σ : firing_script G, q_reducer G q σ ∧ D₂ = D₁ + prin G σ +def reducesTo (G : CFGraph) (q : G.V) (D₁ D₂ : CFDiv G) : Prop := + ∃ σ : firingScript G, qReducer G q σ ∧ D₂ = D₁ + prin G σ -/-- The `reduces_to` relation is reflexive: any divisor reduces to itself via the zero script. -/ +/-- The `reducesTo` relation is reflexive: any divisor reduces to itself via the zero script. -/ private lemma reduces_to_reflexive (G : CFGraph) (q : G.V) (D : CFDiv G) : - reduces_to G q D D := by - refine ⟨0, by simp only [q_reducer, Pi.zero_apply, Std.le_refl, implies_true], + reducesTo G q D D := by + refine ⟨0, by simp only [qReducer, Pi.zero_apply, Std.le_refl, implies_true], by simp only [_root_.map_zero, add_zero]⟩ -/-- The `reduces_to` relation is transitive: composing two $q$-reducer scripts yields a +/-- The `reducesTo` relation is transitive: composing two $q$-reducer scripts yields a $q$-reducer script. -/ private lemma reduces_to_transitive (G : CFGraph) (q : G.V) (D₁ D₂ D₃ : CFDiv G) : - reduces_to G q D₁ D₂ → reduces_to G q D₂ D₃ → reduces_to G q D₁ D₃ := by + reducesTo G q D₁ D₂ → reducesTo G q D₂ D₃ → reducesTo G q D₁ D₃ := by rintro ⟨σ₁, h_reducer_1, h_D2_eq⟩ ⟨σ₂, h_reducer_2, h_D3_eq⟩ use σ₁ + σ₂ refine ⟨?_, ?_⟩ - · - intro v + · intro v repeat rw [Pi.add_apply] apply add_le_add (h_reducer_1 v) (h_reducer_2 v) - · - rw [(prin G).map_add, ← add_assoc] + · rw [(prin G).map_add, ← add_assoc] rw [← h_D2_eq, ← h_D3_eq] /-- Along the $q$-reduction order, the number of chips at $q$ is monotone non-decreasing: a $q$-reducer script sends a nonnegative number of chips toward $q$. -/ private lemma reduces_to_q_mono (G : CFGraph) (q : G.V) {D₁ D₂ : CFDiv G} : - reduces_to G q D₁ D₂ → D₁ q ≤ D₂ q := by + reducesTo G q D₁ D₂ → D₁ q ≤ D₂ q := by rintro ⟨σ, h_reducer, h_eq⟩ have h_prin_q : (prin G σ) q ≥ 0 := by rw [prin_apply] apply Finset.sum_nonneg intro e _ apply mul_nonneg - linarith [h_reducer e] + · linarith [h_reducer e] exact Int.natCast_nonneg _ rw [h_eq, Pi.add_apply] linarith /-- In a connected graph, a firing script with zero principal divisor must be constant. -This is the key step in proving antisymmetry of `reduces_to`. -/ -private lemma constant_script_of_zero_prin {G : CFGraph} (h_conn : graph_connected G) (σ : firing_script G) : prin G σ = 0 → ∀ (v w : G.V), σ v = σ w := by +This is the key step in proving antisymmetry of `reducesTo`. -/ +private lemma constant_script_of_zero_prin {G : CFGraph} (h_conn : graphConnected G) (σ : + firingScript G) : prin G σ = 0 → ∀ (v w : G.V), σ v = σ w := by intro zero_eq let min_exists := Finset.exists_min_image Finset.univ σ (by use Classical.arbitrary G.V; simp only [mem_univ]) @@ -898,7 +901,7 @@ private lemma constant_script_of_zero_prin {G : CFGraph} (h_conn : graph_connect have h_reducer : ∀ v : G.V, σ q ≤ σ v := by intro v; specialize h_reducer v simp only [mem_univ, forall_const] at h_reducer; exact h_reducer - let S := Finset.univ.filter (λ v => σ v = σ q) + let S := Finset.univ.filter (fun v => σ v = σ q) have q_in_S : q ∈ S := by dsimp only [S] simp only [Finset.mem_filter, mem_univ, and_self] @@ -909,7 +912,7 @@ private lemma constant_script_of_zero_prin {G : CFGraph} (h_conn : graph_connect use q, v have := h_conn S h rcases this with ⟨u, h_u_in_S, w, h_w_nin_S, h_edge⟩ - have nonneg_terms: ∀ w : G.V, (σ w - σ u) * (num_edges G u w : ℤ) ≥ 0 := by + have nonneg_terms: ∀ w : G.V, (σ w - σ u) * (numEdges G u w : ℤ) ≥ 0 := by intro w have h_σw_ge_σu : σ w - σ u ≥ 0 := by dsimp only [S] at h_u_in_S h_w_nin_S @@ -917,7 +920,7 @@ private lemma constant_script_of_zero_prin {G : CFGraph} (h_conn : graph_connect specialize h_reducer w linarith apply Int.mul_nonneg h_σw_ge_σu (Nat.cast_nonneg _) - have pos_term : ∃ (w : G.V), (σ w - σ u) * (num_edges G u w : ℤ) > 0 := by + have pos_term : ∃ (w : G.V), (σ w - σ u) * (numEdges G u w : ℤ) > 0 := by use w apply Int.mul_pos · -- Show σ w - σ u > 0 @@ -931,12 +934,12 @@ private lemma constant_script_of_zero_prin {G : CFGraph} (h_conn : graph_connect rw [← h_w_nin_S] apply h_reducer at this linarith - · -- Show num_edges G u w > 0 + · -- Show numEdges G u w > 0 simp only [Int.natCast_pos, h_edge] - have : ∑ u_1 : G.V, (σ u_1 - σ u) * ↑(num_edges G u u_1) >0 := by + have : ∑ u_1 : G.V, (σ u_1 - σ u) * ↑(numEdges G u u_1) >0 := by apply Finset.sum_pos' - intro i _ - exact nonneg_terms i + · intro i _ + exact nonneg_terms i rcases pos_term with ⟨w, h_pos⟩ use w simp only [mem_univ, true_and] @@ -956,8 +959,8 @@ private lemma constant_script_of_zero_prin {G : CFGraph} (h_conn : graph_connect /-- A script that is a $q$-reducer in both directions is constant, and hence has zero principal divisor. This is antisymmetry at the level of scripts; unlike `reduces_to_antisymmetric` it requires no connectivity hypothesis. -/ -private lemma prin_eq_zero_of_two_sided_reducer (G : CFGraph) (q : G.V) (σ : firing_script G) - (h₁ : q_reducer G q σ) (h₂ : q_reducer G q (-σ)) : prin G σ = 0 := by +private lemma prin_eq_zero_of_two_sided_reducer (G : CFGraph) (q : G.V) (σ : firingScript G) + (h₁ : qReducer G q σ) (h₂ : qReducer G q (-σ)) : prin G σ = 0 := by have h_const : ∀ v : G.V, σ v = σ q := by intro v have hv₂ := h₂ v @@ -965,10 +968,11 @@ private lemma prin_eq_zero_of_two_sided_reducer (G : CFGraph) (q : G.V) (σ : fi linarith [h₁ v] rw [show σ = (fun _ : G.V => σ q) from funext h_const, prin_const] -/-- In a connected graph, the `reduces_to` relation is antisymmetric, completing the proof +/-- In a connected graph, the `reducesTo` relation is antisymmetric, completing the proof that it is a partial order on $q$-effective divisors. -/ -private lemma reduces_to_antisymmetric {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D₁ D₂ : CFDiv G) : - reduces_to G q D₁ D₂ → reduces_to G q D₂ D₁ → D₁ = D₂ := by +private lemma reduces_to_antisymmetric {G : CFGraph} (h_conn : graphConnected G) (q : G.V) (D₁ + D₂ : CFDiv G) : + reducesTo G q D₁ D₂ → reducesTo G q D₂ D₁ → D₁ = D₂ := by intro h_red_12 h_red_21 rcases h_red_12 with ⟨σ₁, h_reducer_1, h_D2_eq⟩ rcases h_red_21 with ⟨σ₂, h_reducer_2, h_D1_eq⟩ @@ -978,11 +982,9 @@ private lemma reduces_to_antisymmetric {G : CFGraph} (h_conn : graph_connected G simp only [_root_.map_add, left_eq_add] at h_D1_eq rw [← (prin G).map_add] at h_D1_eq exact h_D1_eq - apply constant_script_of_zero_prin h_conn at prin_sum_zero - -- σ₁ is a q-reducer in both directions, since σ₁ + σ₂ is constant - have h_reducer_1' : q_reducer G q (-σ₁) := by + have h_reducer_1' : qReducer G q (-σ₁) := by intro v repeat rw [Pi.neg_apply] specialize h_reducer_2 v @@ -1010,28 +1012,28 @@ The main results of this section are: (`winnable_iff_q_reduced_effective`). The existence proof proceeds by defining an `active` vertex (one that can still be fired -while maintaining $q$-effectivity) and showing that the `reduction_excess` — the total chips +while maintaining $q$-effectivity) and showing that the `reductionExcess` — the total chips at active vertices — strictly decreases at each reduction step. -/ /-- A set of vertices is legal for `D` if firing it leaves every vertex in the set nonnegative. -/ -def legal_set (G : CFGraph) (D : CFDiv G) (S : Finset G.V) : Prop := - ∀ v ∈ S, outdeg_S G S v ≤ D v +def legalSet (G : CFGraph) (D : CFDiv G) (S : Finset G.V) : Prop := + ∀ v ∈ S, outdegS G S v ≤ D v instance (G : CFGraph) (D : CFDiv G) (S : Finset G.V) : - Decidable (legal_set G D S) := by - unfold legal_set + Decidable (legalSet G D S) := by + unfold legalSet infer_instance @[simp] theorem legal_set_empty (G : CFGraph) (D : CFDiv G) : - legal_set G D (∅ : Finset G.V) := by + legalSet G D (∅ : Finset G.V) := by intro v hv simp at hv theorem effective_set_firing_of_legal_set (G : CFGraph) {D : CFDiv G} - {S : Finset G.V} (hD : effective D) (hS : legal_set G D S) : - effective (set_firing G D S) := by + {S : Finset G.V} (hD : effective D) (hS : legalSet G D S) : + effective (setFiring G D S) := by intro v by_cases hv : v ∈ S · rw [set_firing_apply_of_mem G D hv] @@ -1041,8 +1043,8 @@ theorem effective_set_firing_of_legal_set (G : CFGraph) {D : CFDiv G} /-- Firing a legal set preserves effectivity away from a distinguished vertex. -/ theorem q_effective_set_firing_of_legal_set (G : CFGraph) {q : G.V} {D : CFDiv G} - {S : Finset G.V} (hD : q_effective q D) (hS : legal_set G D S) : - q_effective q (set_firing G D S) := by + {S : Finset G.V} (hD : qEffective q D) (hS : legalSet G D S) : + qEffective q (setFiring G D S) := by intro v hvq by_cases hv : v ∈ S · rw [set_firing_apply_of_mem G D hv] @@ -1050,8 +1052,8 @@ theorem q_effective_set_firing_of_legal_set (G : CFGraph) {q : G.V} {D : CFDiv G · exact le_trans (hD v hvq) (le_set_firing_apply_of_not_mem G D hv) theorem legal_set_union (G : CFGraph) {D : CFDiv G} {S T : Finset G.V} - (hS : legal_set G D S) (hT : legal_set G D T) : - legal_set G D (S ∪ T) := by + (hS : legalSet G D S) (hT : legalSet G D T) : + legalSet G D (S ∪ T) := by intro v hv rcases Finset.mem_union.mp hv with hv | hv · exact le_trans (outdeg_S_antitone G Finset.subset_union_left v) (hS v hv) @@ -1061,15 +1063,15 @@ theorem legal_set_union (G : CFGraph) {D : CFDiv G} {S T : Finset G.V} set of vertices disjoint from $q$ puts some vertex of that set into debt. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 3.4. -/ -def q_reduced (G : CFGraph) (q : G.V) (D : CFDiv G) : Prop := - q_effective q D ∧ - ∀ S : Finset G.V, q ∉ S → S.Nonempty → ¬ legal_set G D S +def qReduced (G : CFGraph) (q : G.V) (D : CFDiv G) : Prop := + qEffective q D ∧ + ∀ S : Finset G.V, q ∉ S → S.Nonempty → ¬ legalSet G D S /-- A nonempty set avoiding `q` contains a vertex that would go into debt when fired from a `q`-reduced divisor. -/ -theorem q_reduced.exists_lt_outdeg {G : CFGraph} {q : G.V} {D : CFDiv G} - (hred : q_reduced G q D) {S : Finset G.V} (hq : q ∉ S) (hS : S.Nonempty) : - ∃ v ∈ S, D v < outdeg_S G S v := by +theorem qReduced.exists_lt_outdeg {G : CFGraph} {q : G.V} {D : CFDiv G} + (hred : qReduced G q D) {S : Finset G.V} (hq : q ∉ S) (hS : S.Nonempty) : + ∃ v ∈ S, D v < outdegS G S v := by by_contra! h exact hred.2 S hq hS h @@ -1077,7 +1079,8 @@ theorem q_reduced.exists_lt_outdeg {G : CFGraph} {q : G.V} {D : CFDiv G} /-- Any firing script $\sigma$ attains its maximum on a nonempty set $S$, and applying $\sigma$ removes at least $\operatorname{outdeg}_S(v)$ chips from each $v \in S$. -/ -private lemma maxset_of_script (G : CFGraph) (σ : firing_script G) : ∃ S : Finset G.V, S.Nonempty ∧ ∀ v ∈ S, (∀ w : G.V, σ w ≤ σ v ∧ (w ∈ S → σ w = σ v)) ∧ -(prin G σ v) ≥ outdeg_S G S v := by +private lemma maxset_of_script (G : CFGraph) (σ : firingScript G) : ∃ S : Finset G.V, S.Nonempty + ∧ ∀ v ∈ S, (∀ w : G.V, σ w ≤ σ v ∧ (w ∈ S → σ w = σ v)) ∧ -(prin G σ v) ≥ outdegS G S v := by let max_exists := Finset.exists_max_image Finset.univ σ (by use Classical.arbitrary G.V; simp only [mem_univ]) rcases max_exists with ⟨w, ⟨_,w_argmax⟩⟩ @@ -1085,31 +1088,30 @@ private lemma maxset_of_script (G : CFGraph) (σ : firing_script G) : ∃ S : Fi use S constructor -- Show S is nonempty - use w; dsimp only [S]; simp only [Finset.mem_filter, mem_univ, and_self] + · use w; dsimp only [S]; simp only [Finset.mem_filter, mem_univ, and_self] intro x x_in_S have h_x : σ x = σ w := by dsimp only [S] at x_in_S; simp only [Finset.mem_filter, mem_univ, true_and] at x_in_S; exact x_in_S - constructor -- Maximality condition - intro y - constructor - · -- Show σ y ≤ σ x - specialize w_argmax y (by simp only [mem_univ]) - rw [h_x]; exact w_argmax - · -- Show that if y ∈ S, then σ y = σ x - intro y_in_S - dsimp only [S] at y_in_S; simp only [Finset.mem_filter, mem_univ, true_and] at y_in_S - rw [h_x]; exact y_in_S + · intro y + constructor + · -- Show σ y ≤ σ x + specialize w_argmax y (by simp only [mem_univ]) + rw [h_x]; exact w_argmax + · -- Show that if y ∈ S, then σ y = σ x + intro y_in_S + dsimp only [S] at y_in_S; simp only [Finset.mem_filter, mem_univ, true_and] at y_in_S + rw [h_x]; exact y_in_S -- Show the outdegree inequality rw [prin_apply] rw [outdeg_S_eq_sum_filter] simp only [ge_iff_le] rw [← Finset.sum_neg_distrib] rw [← Finset.sum_filter_add_sum_filter_not univ (fun x ↦ x ∉ S)] - - have : ∑ x_1 ∈ Finset.filter (fun x ↦ ¬x ∉ S) univ, -((σ x_1 - σ x) * ↑(num_edges G x x_1)) = 0 := by + have : ∑ x_1 ∈ Finset.filter (fun x ↦ ¬x ∉ S) univ, -((σ x_1 - σ x) * ↑(numEdges G x x_1)) = 0 + := by apply Finset.sum_eq_zero intro y h_y have h_y : y ∈ S := by simp only [Decidable.not_not, subset_univ, @@ -1121,11 +1123,11 @@ private lemma maxset_of_script (G : CFGraph) (σ : firing_script G) : ∃ S : Fi rw [this, Int.add_zero] apply Finset.sum_le_sum intro u h_u_notin_S - by_cases h : num_edges G x u = 0 - · -- Case: num_edges G x u = 0 + by_cases h : numEdges G x u = 0 + · -- Case: numEdges G x u = 0 simp only [h, CharP.cast_eq_zero, mul_zero, neg_zero, Std.le_refl] - . -- Case: num_edges G x u ≠ 0 - have h : num_edges G x u > 0 := by + · -- Case: numEdges G x u ≠ 0 + have h : numEdges G x u > 0 := by exact Nat.pos_iff_ne_zero.mpr h suffices 1 ≤ σ x - σ u by rw [neg_mul_eq_neg_mul] @@ -1140,8 +1142,9 @@ private lemma maxset_of_script (G : CFGraph) (σ : firing_script G) : ∃ S : Fi /-- If applying a script $\sigma$ to a $q$-effective divisor yields a $q$-reduced divisor, then $\sigma$ is a $q$-reducer: a $q$-reduced divisor can only be reached from a $q$-effective one by firing $q$ the least. -/ -private lemma q_reducer_of_add_princ_reduced (G : CFGraph) (q : G.V) (D : CFDiv G) (σ : firing_script G) : - q_reduced G q (D + prin G σ) → q_effective q D → q_reducer G q σ := by +private lemma q_reducer_of_add_princ_reduced (G : CFGraph) (q : G.V) (D : CFDiv G) (σ : + firingScript G) : + qReduced G q (D + prin G σ) → qEffective q D → qReducer G q σ := by intro h_q_reduced h_q_effective v have h_eff := h_q_reduced.1 rcases (maxset_of_script G (-σ)) with ⟨S, ⟨w, h_w⟩, h_S⟩ @@ -1151,7 +1154,7 @@ private lemma q_reducer_of_add_princ_reduced (G : CFGraph) (q : G.V) (D : CFDiv ⟨v, v_in_S, h_debt⟩ have dv_neg := lt_of_lt_of_le h_debt (h_S v v_in_S).2 simp only [Pi.add_apply, map_neg, Pi.neg_apply, neg_neg, add_lt_iff_neg_right] at dv_neg - unfold q_effective; push Not; use v + unfold qEffective; push Not; use v suffices v ≠ q by simp only [ne_eq, this, not_false_eq_true, dv_neg, and_self] contrapose! q_nin_S rw [← q_nin_S]; exact v_in_S @@ -1161,9 +1164,10 @@ private lemma q_reducer_of_add_princ_reduced (G : CFGraph) (q : G.V) (D : CFDiv /-- Alternative description of $q$-reduced divisors: they are the maximal $q$-effective divisors in their linear equivalence classes with respect to the $q$-reduction order. -/ -private lemma maximum_of_q_reduced (G : CFGraph) {q : G.V} {D : CFDiv G} : q_reduced G q D → ∀ D' : CFDiv G, linear_equiv G D D' → q_effective q D' → reduces_to G q D' D := by +private lemma maximum_of_q_reduced (G : CFGraph) {q : G.V} {D : CFDiv G} : qReduced G q D → ∀ D' + : CFDiv G, linearEquiv G D D' → qEffective q D' → reducesTo G q D' D := by intro h_q_reduced D' h_lequiv h_eff - unfold linear_equiv at h_lequiv + unfold linearEquiv at h_lequiv obtain ⟨σ, hσ⟩ := (principal_iff_eq_prin G (D'-D)).mp h_lequiv have D_eq : D = D' + (prin G) (-σ) := by rw [map_neg, ←hσ] @@ -1173,35 +1177,37 @@ private lemma maximum_of_q_reduced (G : CFGraph) {q : G.V} {D : CFDiv G} : q_red /-- In a connected graph, every maximal $q$-effective divisor in the $q$-reduction partial order is $q$-reduced. This fact is not needed for future results, but is included for context. -/ -private lemma q_reduced_of_maximal {G : CFGraph} (h_conn : graph_connected G) {q : G.V} {D : CFDiv G} (q_eff : q_effective q D) : (∀ D' : CFDiv G, linear_equiv G D D' → q_effective q D' → reduces_to G q D' D) → q_reduced G q D := by +private lemma q_reduced_of_maximal {G : CFGraph} (h_conn : graphConnected G) {q : G.V} {D : + CFDiv G} (q_eff : qEffective q D) : (∀ D' : CFDiv G, linearEquiv G D D' → qEffective q D' → + reducesTo G q D' D) → qReduced G q D := by intro h_maximal - unfold q_reduced + unfold qReduced constructor - · -- Show q_effective holds + · -- Show qEffective holds exact q_eff · -- Show there is no nonempty legal set avoiding q intro S q_nin_S h_S_nonempty contrapose! h_maximal with h_reduces - let σ := indicator_script G S - have h_reducer : q_reducer G q σ := by + let σ := indicatorScript G S + have h_reducer : qReducer G q σ := by intro v - dsimp only [σ, indicator_script] + dsimp only [σ, indicatorScript] simp only [q_nin_S, ↓reduceIte] by_cases h : v ∈ S <;> simp only [h, ↓reduceIte, Std.le_refl, zero_le_one] use D + prin G σ constructor · -- Show linear equivalence - unfold linear_equiv; simp only [add_sub_cancel_left] + unfold linearEquiv; simp only [add_sub_cancel_left] apply (principal_iff_eq_prin G (prin G σ)).mpr use σ constructor - · -- Show q_effective - rw [show σ = indicator_script G S from rfl, + · -- Show qEffective + rw [show σ = indicatorScript G S from rfl, ← set_firing_eq_add_prin_indicator_script] exact q_effective_set_firing_of_legal_set G q_eff h_reduces - . -- Show ¬ reduces_to + · -- Show ¬ reducesTo by_contra! h_reduces - have h' : reduces_to G q D (D + prin G σ) := by use σ + have h' : reducesTo G q D (D + prin G σ) := by use σ have : D = D + prin G σ := by exact reduces_to_antisymmetric h_conn q D (D + prin G σ) h' h_reduces have prin_zero : prin G σ = 0 := by @@ -1214,7 +1220,7 @@ private lemma q_reduced_of_maximal {G : CFGraph} (h_conn : graph_connected G) {q let h_v := Classical.choose_spec h_S_nonempty have v_S : v ∈ S := by exact h_v specialize prin_zero v q - dsimp only [σ, indicator_script] at prin_zero + dsimp only [σ, indicatorScript] at prin_zero simp only [v_S, ↓reduceIte, q_nin_S, one_ne_zero] at prin_zero /-- The $q$-reduced representative of an effective divisor is effective. @@ -1223,12 +1229,12 @@ A $q$-reduced divisor is maximal in its class for the $q$-reduction order, so $E to $E'$; the number of chips at $q$ only increases along this order, and $E'$ is nonnegative away from $q$ by definition. -/ private lemma q_reduced_of_effective_is_effective (G : CFGraph) (q : G.V) (E E' : CFDiv G) : - effective E → linear_equiv G E E' → q_reduced G q E' → effective E' := by + effective E → linearEquiv G E E' → qReduced G q E' → effective E' := by intro h_eff h_equiv h_qred -- E' is the maximum of its class, so E reduces to E'; chips at q only increase along -- the order, and chips away from q are nonnegative since E' is q-effective. - have h_qeff : q_effective q E := fun v _ => h_eff v - have h_red : reduces_to G q E E' := + have h_qeff : qEffective q E := fun v _ => h_eff v + have h_red : reducesTo G q E E' := maximum_of_q_reduced G h_qred E h_equiv.symm h_qeff intro v by_cases hvq : v = q @@ -1238,7 +1244,7 @@ private lemma q_reduced_of_effective_is_effective (G : CFGraph) (q : G.V) (E E' /-- A winnable $q$-reduced divisor is effective. -/ lemma effective_of_winnable_and_q_reduced (G : CFGraph) (q : G.V) (D : CFDiv G) : - winnable G D → q_reduced G q D → effective D := by + winnable G D → qReduced G q D → effective D := by intro h_winnable h_qred rcases h_winnable with ⟨E, h_eff_E, h_equiv⟩ exact q_reduced_of_effective_is_effective G q E D h_eff_E h_equiv.symm h_qred @@ -1248,22 +1254,22 @@ lemma effective_of_winnable_and_q_reduced (G : CFGraph) (q : G.V) (D : CFDiv G) See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 3.6, part 2 (uniqueness). -/ theorem q_reduced_unique (G : CFGraph) (q : G.V) (D₁ D₂ : CFDiv G) : - q_reduced G q D₁ ∧ q_reduced G q D₂ ∧ linear_equiv G D₁ D₂ → D₁ = D₂ := by + qReduced G q D₁ ∧ qReduced G q D₂ ∧ linearEquiv G D₁ D₂ → D₁ = D₂ := by intro ⟨h_qred_1,h_qred_2,h_lequiv⟩ - unfold linear_equiv at h_lequiv + unfold linearEquiv at h_lequiv simp only [principal_iff_eq_prin] at h_lequiv rcases h_lequiv with ⟨σ, h_D2_eq⟩ - have h_reducer_1 : q_reducer G q σ := by + have h_reducer_1 : qReducer G q σ := by apply q_reducer_of_add_princ_reduced G q D₁ σ - rw [← h_D2_eq] - simp only [add_sub_cancel] - exact h_qred_2 + · rw [← h_D2_eq] + simp only [add_sub_cancel] + exact h_qred_2 exact h_qred_1.left - have h_reducer_2 : q_reducer G q (-σ) := by + have h_reducer_2 : qReducer G q (-σ) := by apply q_reducer_of_add_princ_reduced G q D₂ (-σ) - rw [(prin G).map_neg, ← sub_eq_add_neg] - simp only [← h_D2_eq, sub_sub_cancel] - exact h_qred_1 + · rw [(prin G).map_neg, ← sub_eq_add_neg] + simp only [← h_D2_eq, sub_sub_cancel] + exact h_qred_1 exact h_qred_2.left have h_zero : prin G σ = 0 := prin_eq_zero_of_two_sided_reducer G q σ h_reducer_1 h_reducer_2 @@ -1276,48 +1282,51 @@ theorem q_reduced_unique (G : CFGraph) (q : G.V) (D₁ D₂ : CFDiv G) : /-- A vertex is *active* if there exists a firing script that leaves the divisor effective away from $q$, fires $q$ minimally, and fires this vertex strictly more than $q$. -/ def active (G : CFGraph) (q : G.V) (D : CFDiv G) (v : G.V) : Prop := - ∃ σ : firing_script G, q_reducer G q σ ∧ q_effective q (D + prin G σ) ∧ σ q < σ v + ∃ σ : firingScript G, qReducer G q σ ∧ qEffective q (D + prin G σ) ∧ σ q < σ v /-- A $q$-effective divisor with no active vertices is $q$-reduced. -/ -private lemma q_reduced_of_no_active (G :CFGraph) {q : G.V} {D : CFDiv G} (h_eff : q_effective q D) (h_no_active : ∀ v : G.V, ¬ active G q D v) : - q_reduced G q D := by +private lemma q_reduced_of_no_active (G : CFGraph) {q : G.V} {D : CFDiv G} (h_eff : qEffective q + D) (h_no_active : ∀ v : G.V, ¬ active G q D v) : + qReduced G q D := by contrapose! h_no_active with h_not_q_reduced - dsimp only [q_reduced, ne_eq] at h_not_q_reduced + dsimp only [qReduced, ne_eq] at h_not_q_reduced push Not at h_not_q_reduced rcases h_not_q_reduced h_eff with ⟨S, q_nin_S, h_S_nonempty, h_outdeg⟩ -- Construct a firing script that fires all vertices in S - let σ := indicator_script G S - have h_reducer : q_reducer G q σ := by + let σ := indicatorScript G S + have h_reducer : qReducer G q σ := by intro v - dsimp only [σ, indicator_script] + dsimp only [σ, indicatorScript] simp only [q_nin_S, ↓reduceIte] by_cases h : v ∈ S - simp only [h, ↓reduceIte, zero_le_one]; simp only [h, ↓reduceIte, Std.le_refl] + · simp only [h, ↓reduceIte, zero_le_one] + · simp only [h, ↓reduceIte, Std.le_refl] use Classical.choose h_S_nonempty let h := Classical.choose_spec h_S_nonempty dsimp only [active] use σ refine ⟨h_reducer, ?_, ?_⟩ - · rw [show σ = indicator_script G S from rfl, + · rw [show σ = indicatorScript G S from rfl, ← set_firing_eq_add_prin_indicator_script] exact q_effective_set_firing_of_legal_set G h_eff h_outdeg - · simp only [σ, indicator_script, q_nin_S, ↓reduceIte, h, zero_lt_one] + · simp only [σ, indicatorScript, q_nin_S, ↓reduceIte, h, zero_lt_one] /-- The total number of chips held at active vertices of $D$. This quantity strictly decreases at each step of the $q$-reduction algorithm, providing the termination measure for `q_effective_to_q_reduced`. -/ -noncomputable def reduction_excess (G : CFGraph) (q : G.V) (D : CFDiv G) : ℤ := by +noncomputable def reductionExcess (G : CFGraph) (q : G.V) (D : CFDiv G) : ℤ := by classical exact (∑ v : G.V, if active G q D v then D v else 0) /-- The reduction excess is nonnegative for $q$-effective divisors, since active vertices satisfy $v \ne q$ and hence $D(v) \ge 0$. -/ -private lemma reduction_excess_nonneg (G : CFGraph) {q : G.V} {D : CFDiv G} (h_eff : q_effective q D) : - 0 ≤ reduction_excess G q D := by - dsimp only [reduction_excess] +private lemma reduction_excess_nonneg (G : CFGraph) {q : G.V} {D : CFDiv G} (h_eff : qEffective + q D) : + 0 ≤ reductionExcess G q D := by + dsimp only [reductionExcess] apply Finset.sum_nonneg intro v _ by_cases h_active : active G q D v @@ -1335,12 +1344,13 @@ private lemma reduction_excess_nonneg (G : CFGraph) {q : G.V} {D : CFDiv G} (h_e /-- In a connected graph, every $q$-effective divisor is linearly equivalent to a $q$-reduced divisor. -The proof is by induction on `reduction_excess`. -/ -theorem q_effective_to_q_reduced {G : CFGraph} (h_conn : graph_connected G) {q : G.V} {D : CFDiv G} (h_eff : q_effective q D) : - ∃ E : CFDiv G, q_reduced G q E ∧ linear_equiv G D E := by - -- Use induction on reduction_excess +The proof is by induction on `reductionExcess`. -/ +theorem q_effective_to_q_reduced {G : CFGraph} (h_conn : graphConnected G) {q : G.V} {D : CFDiv + G} (h_eff : qEffective q D) : + ∃ E : CFDiv G, qReduced G q E ∧ linearEquiv G D E := by + -- Use induction on reductionExcess classical -- In order to filter using the undecidable "active" - let S := Finset.univ.filter (λ v : G.V => active G q D v) + let S := Finset.univ.filter (fun v : G.V => active G q D v) have q_nin_S : q ∉ S := by intro h_contra dsimp only [S] at h_contra @@ -1361,8 +1371,8 @@ theorem q_effective_to_q_reduced {G : CFGraph} (h_conn : graph_connected G) {q : rw [h_S_empty] at this -- "this" is not v ∈ ∅, a contradiction simp only [notMem_empty] at this - . -- Linear equivalence - exact linear_equiv.refl G D + · -- Linear equivalence + exact linearEquiv.refl G D · -- Case: There are active vertices. Choose one on the boundary. have : ∃ v : G.V, active G q D v := by contrapose! h_S_empty with h_no_active @@ -1381,31 +1391,29 @@ theorem q_effective_to_q_reduced {G : CFGraph} (h_conn : graph_connected G) {q : dsimp only [active] at v_in_S rcases v_in_S with ⟨σ, h_reducer, h_eff_S, h_ineq⟩ let D' := D + prin G (σ) - have D_equiv_D' : linear_equiv G D D' := by - unfold linear_equiv + have D_equiv_D' : linearEquiv G D D' := by + unfold linearEquiv have : D' - D = prin G σ := by simp only [add_sub_cancel_left, D'] rw [this] apply (principal_iff_eq_prin G (prin G σ)).mpr ⟨σ,rfl⟩ - -- Facts about D', needed for induction - have h_eff' : q_effective q D' := by + have h_eff' : qEffective q D' := by intro x x_ne_q dsimp only [Pi.add_apply, D'] exact h_eff_S x x_ne_q - have h_active_shrinks (x : G.V): active G q D' x → active G q D x := by intro h_active_D' dsimp only [active] rcases h_active_D' with ⟨σ', h_reducer', h_eff'', h_ineq'⟩ use σ + σ' constructor - · -- Show q_reducer + · -- Show qReducer intro y repeat rw [Pi.add_apply] apply add_le_add (h_reducer y) (h_reducer' y) constructor - · -- Show q_effective + · -- Show qEffective intro z z_ne_q dsimp only [D'] at h_eff'' specialize h_eff'' z z_ne_q @@ -1414,10 +1422,10 @@ theorem q_effective_to_q_reduced {G : CFGraph} (h_conn : graph_connected G) {q : · -- Show chips are fired from x repeat rw [Pi.add_apply] apply add_lt_add_of_le_of_lt - exact h_reducer x + · exact h_reducer x exact h_ineq' - - have chips_to_inactive_per_edge (u x : G.V) : ¬ active G q D x → (σ u - σ x) * ↑(num_edges G x u) ≥ 0 := by + have chips_to_inactive_per_edge (u x : G.V) : ¬ active G q D x → (σ u - σ x) * ↑(numEdges G + x u) ≥ 0 := by intro h_inactive_D simp only [ge_iff_le] apply mul_nonneg @@ -1431,23 +1439,22 @@ theorem q_effective_to_q_reduced {G : CFGraph} (h_conn : graph_connected G) {q : specialize h_reducer u linarith linarith - · -- Show num_edges G x u ≥ 0 + · -- Show numEdges G x u ≥ 0 simp only [Nat.cast_nonneg] - have chips_to_inactive (x : G.V) : ¬ active G q D x → D x ≤ D' x := by - -- Goal: 0 ≤ ∑ (σ u - σ x) * num_edges G x u + -- Goal: 0 ≤ ∑ (σ u - σ x) * numEdges G x u intro h_inactive_D simp only [Pi.add_apply, prin_apply, D'] simp only [le_add_iff_nonneg_right] apply Finset.sum_nonneg intro u _ exact chips_to_inactive_per_edge u x h_inactive_D - - have h_smaller : reduction_excess G q D' < reduction_excess G q D := by - dsimp only [reduction_excess] + have h_smaller : reductionExcess G q D' < reductionExcess G q D := by + dsimp only [reductionExcess] repeat rw [Finset.sum_ite, Finset.sum_const_zero, add_zero] -- First, pass to a sum over non-active vertices - have h (D : CFDiv G) : ∑ x ∈ Finset.filter (active G q D) univ, D x = deg D - ∑ x ∈ Finset.filter (fun v => ¬ active G q D v) univ, D x := by + have h (D : CFDiv G) : ∑ x ∈ Finset.filter (active G q D) univ, D x = deg D - ∑ x ∈ + Finset.filter (fun v => ¬ active G q D v) univ, D x := by dsimp only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] rw [← Finset.sum_filter_add_sum_filter_not univ (fun v => active G q D v)] simp only [add_sub_cancel_right] @@ -1457,33 +1464,34 @@ theorem q_effective_to_q_reduced {G : CFGraph} (h_conn : graph_connected G) {q : rw [← this] simp only [sub_lt_sub_iff_left, gt_iff_lt] -- Write as a sum over all vertices in order to compare terms - have h (D : CFDiv G) : ∑ x ∈ Finset.filter (fun v => ¬ active G q D v) univ, D x = ∑ x : G.V, if ¬ active G q D x then D x else 0 := by + have h (D : CFDiv G) : ∑ x ∈ Finset.filter (fun v => ¬ active G q D v) univ, D x = ∑ x : + G.V, if ¬ active G q D x then D x else 0 := by rw [Finset.sum_filter] rw [h D', h D] -- Now compare term-by-term apply Finset.sum_lt_sum -- Show each term is ≤ the corresponding term - intro x _ - by_cases h_active_D' : active G q D' x - · -- Case: x is active in D'. Then already active in D. - have h_active_D := h_active_shrinks x h_active_D' - simp only [h_active_D, not_true_eq_false, ↓reduceIte, h_active_D', Std.le_refl] - · -- Case: x is not active in D'. - simp only [ite_not, h_active_D', not_false_eq_true, ↓reduceIte] - by_cases h_active_D : active G q D x - · -- Subcase: x is active in D - simp only [h_active_D, ↓reduceIte] - -- Show 0 ≤ D' x - apply h_eff' x - intro h_contra - rw [h_contra] at h_active_D - dsimp only [S] at q_nin_S - simp only [Finset.mem_filter, mem_univ, true_and] at q_nin_S - contradiction - · -- Subcase: x is not active in D either - simp only [h_active_D, ↓reduceIte] - -- Show D x ≤ D' x - exact chips_to_inactive x h_active_D + · intro x _ + by_cases h_active_D' : active G q D' x + · -- Case: x is active in D'. Then already active in D. + have h_active_D := h_active_shrinks x h_active_D' + simp only [h_active_D, not_true_eq_false, ↓reduceIte, h_active_D', Std.le_refl] + · -- Case: x is not active in D'. + simp only [ite_not, h_active_D', not_false_eq_true, ↓reduceIte] + by_cases h_active_D : active G q D x + · -- Subcase: x is active in D + simp only [h_active_D, ↓reduceIte] + -- Show 0 ≤ D' x + apply h_eff' x + intro h_contra + rw [h_contra] at h_active_D + dsimp only [S] at q_nin_S + simp only [Finset.mem_filter, mem_univ, true_and] at q_nin_S + contradiction + · -- Subcase: x is not active in D either + simp only [h_active_D, ↓reduceIte] + -- Show D x ≤ D' x + exact chips_to_inactive x h_active_D -- Now, show that strict inequality holds for at least one term use w have h_inactive_D : ¬ active G q D w := by @@ -1498,15 +1506,15 @@ theorem q_effective_to_q_reduced {G : CFGraph} (h_conn : graph_connected G) {q : -- Show D w < D' w simp only [Pi.add_apply, prin_apply, D'] simp only [lt_add_iff_pos_right] - -- Goal: 0 < ∑ (σ u - σ w) * num_edges + -- Goal: 0 < ∑ (σ u - σ w) * numEdges apply Finset.sum_pos' -- Show each term is nonnegative - intro u _ - exact chips_to_inactive_per_edge u w h_inactive_D + · intro u _ + exact chips_to_inactive_per_edge u w h_inactive_D -- Show at least one term is positive use v simp only [mem_univ, true_and] - -- Goal: (σ v - σ w) * num_edges G w v > 0 + -- Goal: (σ v - σ w) * numEdges G w v > 0 apply Int.mul_pos · -- Show σ v - σ w > 0 have : σ w ≤ σ q := by @@ -1515,7 +1523,7 @@ theorem q_effective_to_q_reduced {G : CFGraph} (h_conn : graph_connected G) {q : specialize h_inactive_D σ exact h_inactive_D h_reducer h_eff' linarith [this, h_ineq] - . -- Show num_edges G w v > 0 + · -- Show numEdges G w v > 0 rw [← num_edges_symmetric G v w] simp only [Int.natCast_pos, h_edge] have ih := q_effective_to_q_reduced h_conn h_eff' @@ -1526,22 +1534,23 @@ theorem q_effective_to_q_reduced {G : CFGraph} (h_conn : graph_connected G) {q : exact h_q_reduced · -- Linear equivalence exact D_equiv_D'.trans h_lequiv -termination_by (reduction_excess G q D).toNat +termination_by (reductionExcess G q D).toNat decreasing_by -- Some effort needed to deal with ℤ versus ℕ rw [Int.toNat_lt] - simp only [Int.ofNat_toNat, lt_sup_iff] - dsimp only [D'] at h_smaller - left - exact h_smaller + · simp only [Int.ofNat_toNat, lt_sup_iff] + dsimp only [D'] at h_smaller + left + exact h_smaller exact reduction_excess_nonneg G h_eff' /-- Every divisor is linearly equivalent to some $q$-reduced divisor. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 3.6, part 1 (existence). -/ -theorem exists_q_reduced_representative {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : - ∃ D' : CFDiv G, linear_equiv G D D' ∧ q_reduced G q D' := +theorem exists_q_reduced_representative {G : CFGraph} (h_conn : graphConnected G) (q : G.V) (D : + CFDiv G) : + ∃ D' : CFDiv G, linearEquiv G D D' ∧ qReduced G q D' := by rcases q_effective_exists h_conn q D with ⟨D_eff, h_eff, h_equiv⟩ rcases q_effective_to_q_reduced h_conn h_eff with ⟨D_qred, h_qred, h_lequiv'⟩ @@ -1556,12 +1565,11 @@ by See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 3.6 (existence and uniqueness combined). -/ -lemma unique_q_reduced {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : - ∃! D' : CFDiv G, linear_equiv G D D' ∧ q_reduced G q D' := by +lemma unique_q_reduced {G : CFGraph} (h_conn : graphConnected G) (q : G.V) (D : CFDiv G) : + ∃! D' : CFDiv G, linearEquiv G D D' ∧ qReduced G q D' := by -- Prove existence and uniqueness separately - have h_exists : ∃ D' : CFDiv G, linear_equiv G D D' ∧ q_reduced G q D' := by + have h_exists : ∃ D' : CFDiv G, linearEquiv G D D' ∧ qReduced G q D' := by exact exists_q_reduced_representative h_conn q D - -- Combine existence and uniqueness using the standard constructor obtain ⟨D', hD'⟩ := h_exists refine ExistsUnique.intro D' hD' (fun y hy => ?_) @@ -1571,8 +1579,9 @@ lemma unique_q_reduced {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D : See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 3.7, rephrased. -/ -theorem winnable_iff_q_reduced_effective {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : - winnable G D ↔ ∃ D' : CFDiv G, linear_equiv G D D' ∧ q_reduced G q D' ∧ effective D' := by +theorem winnable_iff_q_reduced_effective {G : CFGraph} (h_conn : graphConnected G) (q : G.V) (D + : CFDiv G) : + winnable G D ↔ ∃ D' : CFDiv G, linearEquiv G D D' ∧ qReduced G q D' ∧ effective D' := by constructor { -- Forward direction intro h_win @@ -1607,14 +1616,14 @@ canonical divisor (see `degree_of_canonical_divisor` in `Orientation.lean`). -/ /-- Rewrites a sum of filtered multiset cardinalities as a sum over mapped incidence counts. -/ -private lemma sum_filter_eq_map (G : CFGraph) (M : Multiset (G.V × G.V)) (crit : G.V → G.V × G.V → Prop) +private lemma sum_filter_eq_map (G : CFGraph) (M : Multiset (G.V × G.V)) (crit : G.V → G.V × + G.V → Prop) [∀ v e, Decidable (crit v e)] : ∑ v : G.V, Multiset.card (M.filter (crit v)) - = Multiset.sum (M.map (λ e => (Finset.univ.filter (λ v => (crit v e) )).card)) := by + = Multiset.sum (M.map (fun e => (Finset.univ.filter (fun v => (crit v e) )).card)) := by -- Define P and g using Prop for clarity in the proof - Available throughout let P : G.V → G.V × G.V → Prop := fun v e => crit v e let g : G.V × G.V → ℕ := fun e => (Finset.univ.filter (P · e)).card - -- Rewrite the goal using P and g for proof readability suffices goal_rewritten : ∑ v : G.V, Multiset.card (M.filter (P v)) = Multiset.sum (M.map g) by exact goal_rewritten -- The goal is now exactly the statement `goal_rewritten` @@ -1627,17 +1636,14 @@ private lemma sum_filter_eq_map (G : CFGraph) (M : Multiset (G.V × G.V)) (crit | cons e_head s_tail ih_s_tail => -- Rewrite RHS: sum(map(g, e_head::s_tail)) = g e_head + sum(map(g, s_tail)) rw [Multiset.map_cons, Multiset.sum_cons] - -- Rewrite LHS: ∑ v, card(filter(P v, e_head::s_tail)) simp_rw [← Multiset.countP_eq_card_filter] simp only [countP_cons] rw [Finset.sum_add_distrib] - -- Simplify the second sum (∑ v, ite (P v e_head) 1 0) to g e_head have h_sum_ite_eq_card : ∑ v : G.V, ite (P v e_head) 1 0 = g e_head := by rw [← Finset.card_filter] -- This completes the proof for h_sum_ite_eq_card rw [h_sum_ite_eq_card] - simp_rw [Multiset.countP_eq_card_filter] rw [add_comm, ih_s_tail] @@ -1645,7 +1651,7 @@ private lemma sum_filter_eq_map (G : CFGraph) (M : Multiset (G.V × G.V)) (crit filtered counts over all vertices gives $c$ times the size of $M$. -/ lemma sum_card_filter_eq_mul (G : CFGraph) (M : Multiset (G.V × G.V)) (crit : G.V → G.V × G.V → Prop) [∀ v e, Decidable (crit v e)] (c : ℕ) - (h_count : ∀ e ∈ M, (Finset.univ.filter (λ v => crit v e)).card = c) : + (h_count : ∀ e ∈ M, (Finset.univ.filter (fun v => crit v e)).card = c) : ∑ v : G.V, Multiset.card (M.filter (crit v)) = c * Multiset.card M := by rw [sum_filter_eq_map G M crit, Multiset.map_congr rfl h_count, Multiset.map_const', Multiset.sum_replicate, Nat.nsmul_eq_mul, Nat.mul_comm] @@ -1661,7 +1667,7 @@ private lemma edge_endpoints_distinct (G : CFGraph) (e : G.V × G.V) (he : e ∈ /-- Each edge is incident to exactly two vertices. -/ private lemma edge_incident_vertices_count (G : CFGraph) (e : G.V × G.V) (he : e ∈ G.edges) : - (Finset.univ.filter (λ v => e.1 = v ∨ e.2 = v)).card = 2 := by + (Finset.univ.filter (fun v => e.1 = v ∨ e.2 = v)).card = 2 := by rw [Finset.card_eq_two] refine ⟨e.1, e.2, edge_endpoints_distinct G e he, ?_⟩ ext v @@ -1671,7 +1677,7 @@ private lemma edge_incident_vertices_count (G : CFGraph) (e : G.V × G.V) (he : private lemma degree_eq_total_flow {T : Type*} [DecidableEq T] [Fintype T] : ∀ (S : Multiset (T × T)) (v : T), (∀ e ∈ S, e.1 ≠ e.2) → ∑ u : T, Multiset.card (Multiset.filter (fun e ↦ e = (v, u) ∨ e = (u, v)) S) = - Multiset.card (S.filter (λ e => e.fst = v ∨ e.snd = v)) := by + Multiset.card (S.filter (fun e => e.fst = v ∨ e.snd = v)) := by -- Induct on the multiset S intro S v h_loopless induction S using Multiset.induction_on with @@ -1682,35 +1688,34 @@ private lemma degree_eq_total_flow {T : Type*} [DecidableEq T] [Fintype T] : simp only [Multiset.filter_cons, card_add, sum_add_distrib] rw [ih_s_tail] -- Cancel the like terms in a + b = a + c - suffices h : - ∑ x : T, Multiset.card (if e_head = (v, x) ∨ e_head = (x, v) then {e_head} else 0) = - Multiset.card (if e_head.1 = v ∨ e_head.2 = v then {e_head} else 0) by - linarith - - rcases e_head with ⟨e, f⟩ - by_cases h_ev : e = v - · subst h_ev - have h_ef : e ≠ f := h_loopless (e, f) (by simp only [Multiset.mem_cons, true_or]) - have h_fv : f ≠ e := by simpa only [ne_eq, eq_comm] using h_ef - rw [Finset.sum_eq_single f] - · simp only [Prod.mk.injEq, true_or, ↓reduceIte, Multiset.card_singleton] - · intro x _ h_x - have h_fx : f ≠ x := fun h => h_x h.symm - simp only [Prod.mk.injEq, h_fx, and_false, h_fv, or_self, ↓reduceIte, Multiset.card_zero] - · simp only [mem_univ, not_true_eq_false, Prod.mk.injEq, true_or, ↓reduceIte, - Multiset.card_singleton, one_ne_zero, imp_self] - · by_cases h_fv : f = v - · subst h_fv - rw [Finset.sum_eq_single e] - · simp only [Prod.mk.injEq, or_true, ↓reduceIte, Multiset.card_singleton] + · suffices h : + ∑ x : T, Multiset.card (if e_head = (v, x) ∨ e_head = (x, v) then {e_head} else 0) = + Multiset.card (if e_head.1 = v ∨ e_head.2 = v then {e_head} else 0) by + linarith + rcases e_head with ⟨e, f⟩ + by_cases h_ev : e = v + · subst h_ev + have h_ef : e ≠ f := h_loopless (e, f) (by simp only [Multiset.mem_cons, true_or]) + have h_fv : f ≠ e := by simpa only [ne_eq, eq_comm] using h_ef + rw [Finset.sum_eq_single f] + · simp only [Prod.mk.injEq, true_or, ↓reduceIte, Multiset.card_singleton] · intro x _ h_x - have h_ex : e ≠ x := fun h => h_x h.symm - simp only [Prod.mk.injEq, h_ev, false_and, h_ex, and_true, or_self, ↓reduceIte, - Multiset.card_zero] - · simp only [mem_univ, not_true_eq_false, Prod.mk.injEq, or_true, ↓reduceIte, + have h_fx : f ≠ x := fun h => h_x h.symm + simp only [Prod.mk.injEq, h_fx, and_false, h_fv, or_self, ↓reduceIte, Multiset.card_zero] + · simp only [mem_univ, not_true_eq_false, Prod.mk.injEq, true_or, ↓reduceIte, Multiset.card_singleton, one_ne_zero, imp_self] - · simp only [Prod.mk.injEq, h_ev, false_and, h_fv, and_false, or_self, ↓reduceIte, - Multiset.card_zero, sum_const_zero] + · by_cases h_fv : f = v + · subst h_fv + rw [Finset.sum_eq_single e] + · simp only [Prod.mk.injEq, or_true, ↓reduceIte, Multiset.card_singleton] + · intro x _ h_x + have h_ex : e ≠ x := fun h => h_x h.symm + simp only [Prod.mk.injEq, h_ev, false_and, h_ex, and_true, or_self, ↓reduceIte, + Multiset.card_zero] + · simp only [mem_univ, not_true_eq_false, Prod.mk.injEq, or_true, ↓reduceIte, + Multiset.card_singleton, one_ne_zero, imp_self] + · simp only [Prod.mk.injEq, h_ev, false_and, h_fv, and_false, or_self, ↓reduceIte, + Multiset.card_zero, sum_const_zero] intro e specialize h_loopless e intro h_tail @@ -1719,8 +1724,8 @@ private lemma degree_eq_total_flow {T : Type*} [DecidableEq T] [Fintype T] : -- Key lemma for handshaking theorem: Sum of edge counts equals incident edge count private lemma sum_num_edges_eq_filter_count (G : CFGraph) (v : G.V) : - ∑ u, num_edges G v u = Multiset.card (G.edges.filter (λ e => e.fst = v ∨ e.snd = v)) := by - dsimp only [num_edges] + ∑ u, numEdges G v u = Multiset.card (G.edges.filter (fun e => e.fst = v ∨ e.snd = v)) := by + dsimp only [numEdges] have h_loopless: ∀ e ∈ G.edges, e.1 ≠ e.2 := by intro e he exact edge_endpoints_distinct G e he @@ -1735,14 +1740,16 @@ $$ $$ -/ theorem sum_vertex_degree_eq_twice_card_edges (G : CFGraph) : - ∑ v, vertex_degree G v = 2 * ↑(Multiset.card G.edges) := by - calc ∑ v, vertex_degree G v - = ∑ v, ∑ u, (num_edges G v u : ℤ) := by simp_rw [vertex_degree] - _ = ∑ v, ↑(∑ u, num_edges G v u) := by simp_rw [← Nat.cast_sum] - _ = ∑ v, ↑(Multiset.card (G.edges.filter (λ e => e.fst = v ∨ e.snd = v))) := by simp_rw [sum_num_edges_eq_filter_count G] - _ = ↑(∑ v, Multiset.card (G.edges.filter (λ e => e.fst = v ∨ e.snd = v))) := by rw [← Nat.cast_sum] + ∑ v, vertexDegree G v = 2 * ↑(Multiset.card G.edges) := by + calc ∑ v, vertexDegree G v + = ∑ v, ∑ u, (numEdges G v u : ℤ) := by simp_rw [vertexDegree] + _ = ∑ v, ↑(∑ u, numEdges G v u) := by simp_rw [← Nat.cast_sum] + _ = ∑ v, ↑(Multiset.card (G.edges.filter (fun e => e.fst = v ∨ e.snd = v))) := by simp_rw + [sum_num_edges_eq_filter_count G] + _ = ↑(∑ v, Multiset.card (G.edges.filter (fun e => e.fst = v ∨ e.snd = v))) := by rw [← + Nat.cast_sum] _ = ↑(2 * Multiset.card G.edges) := by -- Each edge is incident to exactly two vertices - rw [sum_card_filter_eq_mul G G.edges (λ v e => e.fst = v ∨ e.snd = v) 2 + rw [sum_card_filter_eq_mul G G.edges (fun v e => e.fst = v ∨ e.snd = v) 2 (edge_incident_vertices_count G)] _ = 2 * ↑(Multiset.card G.edges) := by rw [Nat.cast_mul, Nat.cast_two] diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean b/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean index f33725f55d..526b2fbbb2 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean @@ -6,9 +6,16 @@ Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger import LeanPool.ChipFiring.ChipFiringWithLean.Basic import Mathlib.LinearAlgebra.Matrix.Symmetric +/-! +# CFGraphExample + +Chip firing, graph divisors, and their combinatorial properties. +-/ + open Multiset Finset +/-- Four vertices used in the concrete chip-firing examples. -/ inductive Person : Type | A | B | C | E deriving DecidableEq @@ -22,6 +29,7 @@ instance : Fintype Person where instance : Nonempty Person := ⟨Person.A⟩ -- Example usage for `Person` in a loopless graph. +/-- Three-edge path on the example vertices. -/ def exampleEdges : Multiset (Person × Person) := Multiset.ofList [ (Person.A, Person.B), @@ -32,6 +40,7 @@ private theorem loopless_example_edges : ∀ v, (v, v) ∉ exampleEdges := by decide -- Example usage for `Person` in a graph with a loop. +/-- Example edge multiset containing a loop at A. -/ def edgesWithLoop : Multiset (Person × Person) := Multiset.ofList [ (Person.A, Person.B), @@ -40,7 +49,8 @@ def edgesWithLoop : Multiset (Person × Person) := ] private theorem loopless_test_edges_with_loop : ¬ (∀ v, (v, v) ∉ edgesWithLoop) := by decide -def example_graph : CFGraph := { +/-- Four-vertex loopless multigraph used to test firing and borrowing operations. -/ +def exampleGraph : CFGraph := { V := Person, edges := Multiset.ofList [ (Person.A, Person.B), (Person.B, Person.C), @@ -50,7 +60,8 @@ def example_graph : CFGraph := { loopless := by decide, } -def initial_wealth : CFDiv example_graph := +/-- Initial divisor with wealth 2, -3, 4, and -1 at A, B, C, and E. -/ +def initialWealth : CFDiv exampleGraph := fun v => match v with | Person.A => 2 | Person.B => -3 @@ -58,113 +69,127 @@ def initial_wealth : CFDiv example_graph := | Person.E => -1 -- Test vertex degrees -private theorem vertex_degree_A : vertex_degree example_graph Person.A = 4 := by rfl -private theorem vertex_degree_B : vertex_degree example_graph Person.B = 2 := by rfl -private theorem vertex_degree_C : vertex_degree example_graph Person.C = 3 := by rfl -private theorem vertex_degree_E : vertex_degree example_graph Person.E = 3 := by rfl +private theorem vertex_degree_A : vertexDegree exampleGraph Person.A = 4 := by rfl +private theorem vertex_degree_B : vertexDegree exampleGraph Person.B = 2 := by rfl +private theorem vertex_degree_C : vertexDegree exampleGraph Person.C = 3 := by rfl +private theorem vertex_degree_E : vertexDegree exampleGraph Person.E = 3 := by rfl -- Test edge counts -private theorem edge_count_AB : num_edges example_graph Person.A Person.B = 1 := by rfl -private theorem edge_count_BA : num_edges example_graph Person.B Person.A = 1 := by rfl -private theorem edge_count_BC : num_edges example_graph Person.B Person.C = 1 := by rfl -private theorem edge_count_CB : num_edges example_graph Person.C Person.B = 1 := by rfl -private theorem edge_count_AC : num_edges example_graph Person.A Person.C = 1 := by rfl -private theorem edge_count_CA : num_edges example_graph Person.C Person.A = 1 := by rfl -private theorem edge_count_AE : num_edges example_graph Person.A Person.E = 2 := by rfl -private theorem edge_count_EA : num_edges example_graph Person.E Person.A = 2 := by rfl -private theorem edge_count_EC : num_edges example_graph Person.E Person.C = 1 := by rfl -private theorem edge_count_CE : num_edges example_graph Person.C Person.E = 1 := by rfl -private theorem edge_count_BE : num_edges example_graph Person.B Person.E = 0 := by rfl -private theorem edge_count_EB : num_edges example_graph Person.E Person.B = 0 := by rfl +private theorem edge_count_AB : numEdges exampleGraph Person.A Person.B = 1 := by rfl +private theorem edge_count_BA : numEdges exampleGraph Person.B Person.A = 1 := by rfl +private theorem edge_count_BC : numEdges exampleGraph Person.B Person.C = 1 := by rfl +private theorem edge_count_CB : numEdges exampleGraph Person.C Person.B = 1 := by rfl +private theorem edge_count_AC : numEdges exampleGraph Person.A Person.C = 1 := by rfl +private theorem edge_count_CA : numEdges exampleGraph Person.C Person.A = 1 := by rfl +private theorem edge_count_AE : numEdges exampleGraph Person.A Person.E = 2 := by rfl +private theorem edge_count_EA : numEdges exampleGraph Person.E Person.A = 2 := by rfl +private theorem edge_count_EC : numEdges exampleGraph Person.E Person.C = 1 := by rfl +private theorem edge_count_CE : numEdges exampleGraph Person.C Person.E = 1 := by rfl +private theorem edge_count_BE : numEdges exampleGraph Person.B Person.E = 0 := by rfl +private theorem edge_count_EB : numEdges exampleGraph Person.E Person.B = 0 := by rfl -- Test No self-loops -private theorem edge_count_AA : num_edges example_graph Person.A Person.A = 0 := by rfl -private theorem edge_count_BB : num_edges example_graph Person.B Person.B = 0 := by rfl -private theorem edge_count_CC : num_edges example_graph Person.C Person.C = 0 := by rfl -private theorem edge_count_EE : num_edges example_graph Person.E Person.E = 0 := by rfl +private theorem edge_count_AA : numEdges exampleGraph Person.A Person.A = 0 := by rfl +private theorem edge_count_BB : numEdges exampleGraph Person.B Person.B = 0 := by rfl +private theorem edge_count_CC : numEdges exampleGraph Person.C Person.C = 0 := by rfl +private theorem edge_count_EE : numEdges exampleGraph Person.E Person.E = 0 := by rfl -- Test Charlie lending through an individual firing move -def after_charlie_lends := firing_move example_graph initial_wealth Person.C -private theorem charlie_wealth_after_lending : after_charlie_lends Person.C = 1 := by rfl -private theorem bob_wealth_after_charlie_lends : after_charlie_lends Person.B = -2 := by rfl +/-- Divisor after C fires once from the initial configuration. -/ +def afterCharlieLends := firingMove exampleGraph initialWealth Person.C +private theorem charlie_wealth_after_lending : afterCharlieLends Person.C = 1 := by rfl +private theorem bob_wealth_after_charlie_lends : afterCharlieLends Person.B = -2 := by rfl -- Test set firing W₁ = {A,E,C} -def W₁ : Finset example_graph.V := {Person.A, Person.E, Person.C} -def after_W₁_firing := set_firing example_graph initial_wealth W₁ -private theorem alice_wealth_after_W₁ : after_W₁_firing Person.A = 1 := by rfl -private theorem bob_wealth_after_W₁ : after_W₁_firing Person.B = -1 := by rfl -private theorem charlie_wealth_after_W₁ : after_W₁_firing Person.C = 3 := by rfl -private theorem elise_wealth_after_W₁ : after_W₁_firing Person.E = -1 := by rfl +/-- First set of vertices fired in the example sequence. -/ +def W₁ : Finset exampleGraph.V := {Person.A, Person.E, Person.C} +/-- Divisor after firing A, E, and C from the initial configuration. -/ +def afterW₁Firing := setFiring exampleGraph initialWealth W₁ +private theorem alice_wealth_after_W₁ : afterW₁Firing Person.A = 1 := by rfl +private theorem bob_wealth_after_W₁ : afterW₁Firing Person.B = -1 := by rfl +private theorem charlie_wealth_after_W₁ : afterW₁Firing Person.C = 3 := by rfl +private theorem elise_wealth_after_W₁ : afterW₁Firing Person.E = -1 := by rfl -- Test set firing W₂ = {A,E,C} -def W₂ : Finset example_graph.V := W₁ -def after_W₂_firing := set_firing example_graph after_W₁_firing W₂ -private theorem alice_wealth_after_W₂ : after_W₂_firing Person.A = 0 := by rfl -private theorem bob_wealth_after_W₂ : after_W₂_firing Person.B = 1 := by rfl -private theorem charlie_wealth_after_W₂ : after_W₂_firing Person.C = 2 := by rfl -private theorem elise_wealth_after_W₂ : after_W₂_firing Person.E = -1 := by rfl +/-- Second firing set, repeating the first set of vertices. -/ +def W₂ : Finset exampleGraph.V := W₁ +/-- Divisor after the second firing of A, E, and C. -/ +def afterW₂Firing := setFiring exampleGraph afterW₁Firing W₂ +private theorem alice_wealth_after_W₂ : afterW₂Firing Person.A = 0 := by rfl +private theorem bob_wealth_after_W₂ : afterW₂Firing Person.B = 1 := by rfl +private theorem charlie_wealth_after_W₂ : afterW₂Firing Person.C = 2 := by rfl +private theorem elise_wealth_after_W₂ : afterW₂Firing Person.E = -1 := by rfl -- Test set firing W₃ = {B,C} -def W₃ : Finset example_graph.V := {Person.B, Person.C} -def after_W₃_firing := set_firing example_graph after_W₂_firing W₃ -private theorem alice_wealth_after_W₃ : after_W₃_firing Person.A = 2 := by rfl -private theorem bob_wealth_after_W₃ : after_W₃_firing Person.B = 0 := by rfl -private theorem charlie_wealth_after_W₃ : after_W₃_firing Person.C = 0 := by rfl -private theorem elise_wealth_after_W₃ : after_W₃_firing Person.E = 0 := by rfl +/-- Final firing set consisting of B and C. -/ +def W₃ : Finset exampleGraph.V := {Person.B, Person.C} +/-- Effective divisor obtained after the three set-firing steps. -/ +def afterW₃Firing := setFiring exampleGraph afterW₂Firing W₃ +private theorem alice_wealth_after_W₃ : afterW₃Firing Person.A = 2 := by rfl +private theorem bob_wealth_after_W₃ : afterW₃Firing Person.B = 0 := by rfl +private theorem charlie_wealth_after_W₃ : afterW₃Firing Person.C = 0 := by rfl +private theorem elise_wealth_after_W₃ : afterW₃Firing Person.E = 0 := by rfl -- Test borrowing moves -def after_bob_borrows := borrowing_move example_graph initial_wealth Person.B -private theorem bob_wealth_after_borrowing : after_bob_borrows Person.B = -1 := by rfl -private theorem alice_wealth_after_bob_borrows : after_bob_borrows Person.A = 1 := by rfl -private theorem charlie_wealth_after_bob_borrows : after_bob_borrows Person.C = 3 := by rfl +/-- Divisor after B borrows once from the initial configuration. -/ +def afterBobBorrows := borrowingMove exampleGraph initialWealth Person.B +private theorem bob_wealth_after_borrowing : afterBobBorrows Person.B = -1 := by rfl +private theorem alice_wealth_after_bob_borrows : afterBobBorrows Person.A = 1 := by rfl +private theorem charlie_wealth_after_bob_borrows : afterBobBorrows Person.C = 3 := by rfl -- Test degree of divisors -private theorem initial_wealth_degree : deg initial_wealth = 2 := by rfl -private theorem after_W₁_degree : deg after_W₁_firing = 2 := by rfl -private theorem after_W₂_degree : deg after_W₂_firing = 2 := by rfl -private theorem after_W₃_degree : deg after_W₃_firing = 2 := by rfl +private theorem initial_wealth_degree : deg initialWealth = 2 := by rfl +private theorem after_W₁_degree : deg afterW₁Firing = 2 := by rfl +private theorem after_W₂_degree : deg afterW₂Firing = 2 := by rfl +private theorem after_W₃_degree : deg afterW₃Firing = 2 := by rfl -- Test effectiveness of divisors -private theorem initial_not_effective : ¬(effective initial_wealth) := by unfold effective; decide -private theorem after_W₃_firing_effective : effective after_W₃_firing := by unfold effective; decide +private theorem initial_not_effective : ¬(effective initialWealth) := by unfold effective; decide +private theorem after_W₃_firing_effective : effective afterW₃Firing := by unfold effective; decide -- Test Laplacian matrix values and symmetricity -def example_laplacian := laplacian_matrix example_graph -private theorem laplacian_diagonal_A : example_laplacian Person.A Person.A = 4 := by rfl -private theorem laplacian_diagonal_B : example_laplacian Person.B Person.B = 2 := by rfl -private theorem laplacian_diagonal_C : example_laplacian Person.C Person.C = 3 := by rfl -private theorem laplacian_diagonal_E : example_laplacian Person.E Person.E = 3 := by rfl -private theorem laplacian_off_diagonal_AB : example_laplacian Person.A Person.B = -1 := by rfl -private theorem laplacian_off_diagonal_AC : example_laplacian Person.A Person.C = -1 := by rfl -private theorem laplacian_off_diagonal_AE : example_laplacian Person.A Person.E = -2 := by rfl -private theorem laplacian_off_diagonal_BC : example_laplacian Person.B Person.C = -1 := by rfl -private theorem laplacian_off_diagonal_BE : example_laplacian Person.B Person.E = 0 := by rfl -private theorem laplacian_off_diagonal_CE : example_laplacian Person.C Person.E = -1 := by rfl -private theorem check_example_laplacian_symmetry : Matrix.IsSymm example_laplacian := by { +/-- Integer Laplacian matrix of the example multigraph. -/ +def exampleLaplacian := laplacianMatrix exampleGraph +private theorem laplacian_diagonal_A : exampleLaplacian Person.A Person.A = 4 := by rfl +private theorem laplacian_diagonal_B : exampleLaplacian Person.B Person.B = 2 := by rfl +private theorem laplacian_diagonal_C : exampleLaplacian Person.C Person.C = 3 := by rfl +private theorem laplacian_diagonal_E : exampleLaplacian Person.E Person.E = 3 := by rfl +private theorem laplacian_off_diagonal_AB : exampleLaplacian Person.A Person.B = -1 := by rfl +private theorem laplacian_off_diagonal_AC : exampleLaplacian Person.A Person.C = -1 := by rfl +private theorem laplacian_off_diagonal_AE : exampleLaplacian Person.A Person.E = -2 := by rfl +private theorem laplacian_off_diagonal_BC : exampleLaplacian Person.B Person.C = -1 := by rfl +private theorem laplacian_off_diagonal_BE : exampleLaplacian Person.B Person.E = 0 := by rfl +private theorem laplacian_off_diagonal_CE : exampleLaplacian Person.C Person.E = -1 := by rfl +private theorem check_example_laplacian_symmetry : Matrix.IsSymm exampleLaplacian := by { apply Matrix.IsSymm.ext intro i j cases i <;> cases j <;> rfl } -- Test script firing through laplacians -def firing_script_example : firing_script example_graph := fun v => match v with +/-- Firing script in which C fires once and B borrows once. -/ +def firingScriptExample : firingScript exampleGraph := fun v => match v with | Person.A => 0 | Person.B => -1 | Person.C => 1 | Person.E => 0 -def res_div_post_lap_based_script_firing := apply_laplacian example_graph firing_script_example initial_wealth -private theorem lap_based_script_firing_preserves_degree : deg res_div_post_lap_based_script_firing = 2 := by rfl +/-- Divisor obtained by applying the example firing script through the Laplacian. -/ +def resDivPostLapBasedScriptFiring := applyLaplacian exampleGraph firingScriptExample initialWealth +private theorem lap_based_script_firing_preserves_degree : deg resDivPostLapBasedScriptFiring = + 2 := by rfl -- Test divisor that is not q-reduced with respect to Person.A -def non_q_reduced_example : CFDiv example_graph := fun v => match v with +/-- Example divisor that is not A-reduced because B has negative wealth. -/ +def nonQReducedExample : CFDiv exampleGraph := fun v => match v with | Person.A => 1 | Person.B => -1 -- violates non-negativity condition for non-q vertices | Person.C => 2 | Person.E => 1 -private theorem non_q_reduced_example_is_invalid : ¬q_reduced example_graph Person.A non_q_reduced_example := by { +private theorem non_q_reduced_example_is_invalid : ¬qReduced exampleGraph Person.A + nonQReducedExample := by { rintro ⟨h1, _⟩ - have h1' : ∀ v : Person, v ≠ Person.A → non_q_reduced_example v ≥ 0 := h1 - simpa only [non_q_reduced_example, Int.reduceNeg, Int.neg_nonneg, Int.reduceLE] + have h1' : ∀ v : Person, v ≠ Person.A → nonQReducedExample v ≥ 0 := h1 + simpa only [nonQReducedExample, Int.reduceNeg, Int.neg_nonneg, Int.reduceLE] using h1' Person.B (by decide) } diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean index 9ea8b05aef..0e092249af 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean @@ -5,9 +5,6 @@ Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ import LeanPool.ChipFiring.ChipFiringWithLean.Basic - -open Multiset Finset - /-! ## Configurations and superstable configurations @@ -22,13 +19,18 @@ out-degree to $V(G) \setminus S$. Equivalently, the associated divisor is $q$-re A *maximal superstable* configuration is one that is not dominated by any other superstable configuration. -The quantity `outdeg_S G S v` counts edges from $v$ to vertices outside $S$, and is the +The quantity `outdegS G S v` counts edges from $v$ to vertices outside $S$, and is the relevant threshold for the superstability condition. -/ + +open Multiset Finset + + + /-- The set of vertices other than $q$: $\widetilde V = V(G) \setminus \{q\}$. -/ abbrev Vtilde {G : CFGraph} (q : G.V) : Finset G.V := - univ.filter (λ v => v ≠ q) + univ.filter (fun v => v ≠ q) /-- A *configuration* on $G$ with respect to distinguished vertex $q$ is a nonnegative integer assignment to all vertices, with the convention that $q$ holds zero chips. This is what @@ -48,13 +50,13 @@ $$ \deg(c) = \sum_{v \in V(G)\setminus\{q\}} c(v). $$ Since $c(q)=0$, this is implemented as the degree of the underlying divisor. -/ -def config_degree {G : CFGraph} {q : G.V} (c : Config G q) : ℤ := +def configDegree {G : CFGraph} {q : G.V} (c : Config G q) : ℤ := deg (c.chips) /-- Converts a configuration $c$ to a divisor of prescribed degree $d$ by placing $d-\deg(c)$ chips at $q$. -/ def toDiv {G : CFGraph} {q : G.V} (d : ℤ) (c : Config G q) : CFDiv G := - c.chips + (d - config_degree c) • (one_chip q) + c.chips + (d - configDegree c) • (oneChip q) /-- Two configurations are equal if their chip counts agree at every vertex. -/ @[ext] lemma Config.ext {q : G.V} {c₁ c₂ : Config G q} @@ -70,11 +72,12 @@ lemma eq_config_iff_eq_chips {q : G.V} (c₁ c₂ : Config G q) : ⟨fun h => by rw [h], fun h => Config.ext (congrFun h)⟩ /-- Two configurations are equal if and only if their images under `toDiv d` agree. -/ -lemma eq_config_iff_eq_div {q : G.V} (d : ℤ) (c₁ c₂ : Config G q) : c₁ = c₂ ↔ toDiv d c₁ = toDiv d c₂ := by +lemma eq_config_iff_eq_div {q : G.V} (d : ℤ) (c₁ c₂ : Config G q) : c₁ = c₂ ↔ toDiv d c₁ = toDiv + d c₂ := by constructor -- Forward direction is clear - intro h_eq - rw [h_eq] + · intro h_eq + rw [h_eq] -- Reverse direction takes more intro h_eq apply congrFun at h_eq @@ -82,16 +85,16 @@ lemma eq_config_iff_eq_div {q : G.V} (d : ℤ) (c₁ c₂ : Config G q) : c₁ = specialize h_eq v dsimp only [toDiv, Pi.add_apply, Pi.smul_apply, Int.zsmul_eq_mul] at h_eq by_cases h_v : q = v - . -- Case v = q + · -- Case v = q rw [← h_v] rw [c₁.q_zero, c₂.q_zero] - . -- Case v ≠ q + · -- Case v ≠ q simp only [ne_eq, h_v, not_false_eq_true, one_chip_apply_other, mul_zero, add_zero] at h_eq exact h_eq /-- Converts a configuration $c$ to the $q$-effective divisor `toDiv d c`, bundled with its proof of $q$-effectivity. -/ -def to_qed {q : G.V} (d : ℤ) (c : Config G q) : q_eff_div G q := +def toQed {q : G.V} (d : ℤ) (c : Config G q) : qEffDiv G q := { D := toDiv d c, h_eff := by @@ -102,11 +105,11 @@ def to_qed {q : G.V} (d : ℤ) (c : Config G q) : q_eff_div G q := exact c.non_negative v } /-- Converts a $q$-effective divisor to a configuration by zeroing out the chip count at $q$. -/ -def toConfig {q : G.V} (D : q_eff_div G q) : Config G q := { - chips := D.D - (D.D q) • (one_chip q) +def toConfig {q : G.V} (D : qEffDiv G q) : Config G q := { + chips := D.D - (D.D q) • (oneChip q) q_zero := by rw [Pi.sub_apply, Pi.smul_apply, smul_eq_mul] - dsimp only [one_chip] + dsimp only [oneChip] simp only [↓reduceIte, mul_one, sub_self] non_negative := by intro v @@ -114,62 +117,63 @@ def toConfig {q : G.V} (D : q_eff_div G q) : Config G q := { · -- Case v = q simp only [zsmul_eq_mul, h_v, Pi.sub_apply, Pi.mul_apply, Pi.intCast_apply, Int.cast_eq, one_chip_apply_v, mul_one, sub_self, ge_iff_le, Std.le_refl] - . -- Case v ≠ q + · -- Case v ≠ q simp only [zsmul_eq_mul, Pi.sub_apply, Pi.mul_apply, Pi.intCast_apply, Int.cast_eq, ne_eq, h_v, not_false_eq_true, one_chip_apply_other', mul_zero, sub_zero, ge_iff_le] exact D.h_eff v h_v } /-- The degree of a $q$-effective divisor equals its value at $q$ plus the configuration degree. -/ -lemma config_degree_div_degree {q : G.V} (D : q_eff_div G q) : deg D.D = D.D q + config_degree (toConfig D) := by - simp only [config_degree, toConfig, map_sub, map_zsmul, deg_one_chip, smul_eq_mul, mul_one] +lemma config_degree_div_degree {q : G.V} (D : qEffDiv G q) : deg D.D = D.D q + configDegree + (toConfig D) := by + simp only [configDegree, toConfig, map_sub, map_zsmul, deg_one_chip, smul_eq_mul, mul_one] ring /-- Shifting the prescribed degree by $k$ adds $k$ chips at $q$. -/ @[simp] lemma toDiv_config_degree_add {q : G.V} (c : Config G q) (k : ℤ) : - toDiv (config_degree c + k) c = c.chips + k • one_chip q := by + toDiv (configDegree c + k) c = c.chips + k • oneChip q := by dsimp only [toDiv] - rw [show config_degree c + k - config_degree c = k by ring] + rw [show configDegree c + k - configDegree c = k by ring] /-- Prescribing degree $\deg(c)-1$ gives the divisor $c-q$. -/ @[simp] private lemma toDiv_config_degree_sub_one {q : G.V} (c : Config G q) : - toDiv (config_degree c - 1) c = c.chips - one_chip q := by - rw [show config_degree c - 1 = config_degree c + (-1) by ring] + toDiv (configDegree c - 1) c = c.chips - oneChip q := by + rw [show configDegree c - 1 = configDegree c + (-1) by ring] rw [toDiv_config_degree_add] simp only [Int.reduceNeg, neg_smul, one_smul, sub_eq_add_neg] /-- The divisor $c-q$ has degree $\deg(c)-1$. -/ @[simp] lemma deg_chips_sub_one_chip {q : G.V} (c : Config G q) : - deg (c.chips - one_chip q) = config_degree c - 1 := by - rw [map_sub, config_degree, deg_one_chip] + deg (c.chips - oneChip q) = configDegree c - 1 := by + rw [map_sub, configDegree, deg_one_chip] -/-- `toConfig` is a left inverse of `to_qed`: converting a configuration to a $q$-effective +/-- `toConfig` is a left inverse of `toQed`: converting a configuration to a $q$-effective divisor and back recovers the original configuration. -/ -private lemma config_of_div_of_config (c : Config G q) (d : ℤ) : - toConfig (to_qed d c) = c := by +private lemma config_of_div_of_config (c : Config G q) (d : ℤ) : + toConfig (toQed d c) = c := by rcases c with ⟨chips, q_zero, non_negative⟩ - dsimp only [to_qed, toConfig] + dsimp only [toQed, toConfig] simp only [zsmul_eq_mul, Config.mk.injEq] apply funext intro v by_cases h_v : v = q - . -- Case v = q + · -- Case v = q simp only [h_v, Pi.sub_apply, Pi.mul_apply, Pi.intCast_apply, Int.cast_eq, one_chip_apply_v, mul_one, sub_self] rw [q_zero] - . -- Case v ≠ q - dsimp only [toDiv, Pi.add_apply, Pi.smul_apply, one_chip, Int.zsmul_eq_mul, Pi.sub_apply, + · -- Case v ≠ q + dsimp only [toDiv, Pi.add_apply, Pi.smul_apply, oneChip, Int.zsmul_eq_mul, Pi.sub_apply, Pi.mul_apply, Pi.intCast_apply, Int.cast_eq] simp only [h_v, ↓reduceIte, mul_zero, add_zero, mul_one, sub_zero] -/-- `to_qed` is a left inverse of `toConfig` at the correct degree: converting a $q$-effective +/-- `toQed` is a left inverse of `toConfig` at the correct degree: converting a $q$-effective divisor to a configuration and back via `toDiv (deg D.D)` recovers the original divisor. -/ -lemma div_of_config_of_div (D : q_eff_div G q) : +lemma div_of_config_of_div (D : qEffDiv G q) : toDiv (deg D.D) (toConfig D) = D.D := by funext v dsimp only [toDiv, Pi.add_apply, Pi.smul_apply, Int.zsmul_eq_mul] by_cases h: v ∈ Vtilde q - . -- Case v ∈ Vtilde q + · -- Case v ∈ Vtilde q dsimp only [toConfig, Pi.sub_apply, Pi.smul_apply, Int.zsmul_eq_mul] have : v ≠ q := by intro h_eq_q @@ -177,47 +181,47 @@ lemma div_of_config_of_div (D : q_eff_div G q) : simp only [Finset.mem_filter, mem_univ, ne_eq, not_true_eq_false, and_false] at h simp only [ne_eq, this, not_false_eq_true, one_chip_apply_other', mul_zero, sub_zero, zsmul_eq_mul, add_zero] - . -- Case v ∉ Vtilde q + · -- Case v ∉ Vtilde q have : v = q := by contrapose! h simp only [Finset.mem_filter, mem_univ, ne_eq, h, not_false_eq_true, and_self] rw [this] - simp only [(toConfig D).q_zero, one_chip, ite_true, mul_one, zero_add] + simp only [(toConfig D).q_zero, oneChip, ite_true, mul_one, zero_add] linarith [config_degree_div_degree D] /-- A $q$-reduced divisor is recovered by converting to its canonical configuration and back. -/ @[simp] lemma q_reduced_toDiv_toConfig (G : CFGraph) (q : G.V) (D : CFDiv G) - (h_qred : q_reduced G q D) : + (h_qred : qReduced G q D) : toDiv (deg D) (toConfig ⟨D, h_qred.1⟩) = D := div_of_config_of_div ⟨D, h_qred.1⟩ /-- A $q$-reduced divisor is its canonical configuration plus its chips at $q$. -/ lemma q_reduced_eq_chips_add_q (G : CFGraph) (q : G.V) (D : CFDiv G) - (h_qred : q_reduced G q D) : - D = (toConfig ⟨D, h_qred.1⟩).chips + D q • one_chip q := by + (h_qred : qReduced G q D) : + D = (toConfig ⟨D, h_qred.1⟩).chips + D q • oneChip q := by let c : Config G q := toConfig ⟨D, h_qred.1⟩ - have h_deg : deg D = config_degree c + D q := by + have h_deg : deg D = configDegree c + D q := by simpa only [add_comm] using (config_degree_div_degree ⟨D, h_qred.1⟩) calc D = toDiv (deg D) c := by exact (q_reduced_toDiv_toConfig G q D h_qred).symm - _ = toDiv (config_degree c + D q) c := by rw [h_deg] - _ = c.chips + D q • one_chip q := toDiv_config_degree_add c (D q) + _ = toDiv (configDegree c + D q) c := by rw [h_deg] + _ = c.chips + D q • oneChip q := toDiv_config_degree_add c (D q) /-- If a $q$-reduced divisor has value $-1$ at $q$, it is exactly $c-q$ for its canonical configuration $c$. -/ lemma q_reduced_eq_chips_sub_one_chip (G : CFGraph) (q : G.V) (D : CFDiv G) - (h_qred : q_reduced G q D) (h_q : D q = -1) : - D = (toConfig ⟨D, h_qred.1⟩).chips - one_chip q := by + (h_qred : qReduced G q D) (h_q : D q = -1) : + D = (toConfig ⟨D, h_qred.1⟩).chips - oneChip q := by calc - D = (toConfig ⟨D, h_qred.1⟩).chips + D q • one_chip q := + D = (toConfig ⟨D, h_qred.1⟩).chips + D q • oneChip q := q_reduced_eq_chips_add_q G q D h_qred - _ = (toConfig ⟨D, h_qred.1⟩).chips + (-1 : ℤ) • one_chip q := by rw [h_q] - _ = (toConfig ⟨D, h_qred.1⟩).chips - one_chip q := by + _ = (toConfig ⟨D, h_qred.1⟩).chips + (-1 : ℤ) • oneChip q := by rw [h_q] + _ = (toConfig ⟨D, h_qred.1⟩).chips - oneChip q := by simp only [Int.reduceNeg, neg_smul, one_smul, sub_eq_add_neg] @[simp] private lemma eval_toDiv_q {q : G.V} (d : ℤ) (c : Config G q) : - toDiv d c q = d - config_degree c := by + toDiv d c q = d - configDegree c := by dsimp only [toDiv, Pi.add_apply, Pi.smul_apply, Int.zsmul_eq_mul] simp only [c.q_zero, one_chip_apply_v, mul_one, zero_add] @@ -229,14 +233,15 @@ lemma q_reduced_eq_chips_sub_one_chip (G : CFGraph) (q : G.V) (D : CFDiv G) /-- The divisor `toDiv d c` is effective if and only if $d \ge \deg(c)$, i.e. there are enough chips at $q$ to cover any debt. -/ -lemma config_eff {q : G.V} (d : ℤ) (c : Config G q) : effective (toDiv d c) ↔ d ≥ config_degree c := by +lemma config_eff {q : G.V} (d : ℤ) (c : Config G q) : effective (toDiv d c) ↔ d ≥ configDegree c + := by constructor - -- Effective implies d ≥ config_degree - intro h_eff - have h := h_eff q - rw [eval_toDiv_q] at h - linarith - -- d ≥ config_degree implies effective + -- Effective implies d ≥ configDegree + · intro h_eff + have h := h_eff q + rw [eval_toDiv_q] at h + linarith + -- d ≥ configDegree implies effective intro h_deg v by_cases h_v : v = q · -- Case v = q @@ -246,7 +251,7 @@ lemma config_eff {q : G.V} (d : ℤ) (c : Config G q) : effective (toDiv d c) exact c.non_negative v instance : PartialOrder (Config G q) := { - le := λ c₁ c₂ => c₁.chips ≤ c₂.chips, + le := fun c₁ c₂ => c₁.chips ≤ c₂.chips, le_refl := by intro _ simp only [Std.le_refl], @@ -262,16 +267,16 @@ instance : PartialOrder (Config G q) := { /-- The configuration degree is monotone: if $c \le c'$ pointwise, then $\deg(c) \le \deg(c')$. -/ lemma config_degree_mono {q : G.V} {c c' : Config G q} (h_le : c ≤ c') : - config_degree c ≤ config_degree c' := by - dsimp only [config_degree, deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] + configDegree c ≤ configDegree c' := by + dsimp only [configDegree, deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] exact Finset.sum_le_sum fun v _ => h_le v /-- Two configurations are equal if one is pointwise bounded above by the other and they have the same degree. -/ lemma config_eq_of_le_and_degree {q : G.V} {c1 c2 : Config G q} (h_le : c2 ≤ c1) - (h_deg : config_degree c1 = config_degree c2) : c1 = c2 := by + (h_deg : configDegree c1 = configDegree c2) : c1 = c2 := by apply (eq_config_iff_eq_chips c1 c2).mpr - dsimp only [config_degree, deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] at h_deg + dsimp only [configDegree, deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] at h_deg have h_le' : ∀ v : G.V, c2.chips v ≤ c1.chips v := by intro v exact h_le v @@ -285,9 +290,9 @@ lemma config_eq_of_le_and_degree {q : G.V} {c1 c2 : Config G q} (h_le : c2 ≤ c apply lt_of_le_of_ne h_le' contrapose! h_v_ne simp only [h_v_ne] - suffices config_degree c2 < config_degree c1 by + suffices configDegree c2 < configDegree c1 by exact ne_of_gt this - dsimp only [config_degree, deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] + dsimp only [configDegree, deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] refine Finset.sum_lt_sum ?_ ?_ · intro i _ exact h_le' i @@ -301,37 +306,37 @@ out-degree to $V(G) \setminus S$. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 3.12. -/ def superstable (G : CFGraph) (q : G.V) (c : Config G q) : Prop := ∀ S ⊆ Vtilde q, S.Nonempty → - ∃ v ∈ S, c.chips v < outdeg_S G S v + ∃ v ∈ S, c.chips v < outdegS G S v /-- A configuration $c$ is superstable if and only if `toDiv d c` is $q$-reduced, for any prescribed degree $d$. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Remark 3.14. -/ lemma superstable_iff_q_reduced (G : CFGraph) (q : G.V) (d : ℤ) (c : Config G q) : - superstable G q c ↔ q_reduced G q (toDiv d c) := by + superstable G q c ↔ qReduced G q (toDiv d c) := by dsimp only [superstable, ne_eq] constructor -- Forward direction - intro h_superstable - constructor - -- Show c is nonnegative away from v - intro v hv_ne_q - dsimp only [toDiv, Pi.add_apply, Pi.smul_apply, Int.zsmul_eq_mul] - simp only [ne_eq, hv_ne_q, not_false_eq_true, one_chip_apply_other', mul_zero, add_zero, - ge_iff_le] - exact c.non_negative v - -- Show there is no nonempty legal set avoiding q - intro S hq hS_nonempty hlegal - have hS_subset : S ⊆ Vtilde q := by - intro v hv_in_S - simp only [Vtilde, Finset.mem_filter, mem_univ, true_and] - exact fun hvq => hq (hvq ▸ hv_in_S) - obtain ⟨v, hv_in_S, hv_outdeg⟩ := h_superstable S hS_subset hS_nonempty - have h_v_ne_q : v ≠ q := by - exact fun hvq => hq (hvq ▸ hv_in_S) - have hge := hlegal v hv_in_S - rw [eval_toDiv_ne_q d c h_v_ne_q] at hge - omega + · intro h_superstable + constructor + -- Show c is nonnegative away from v + · intro v hv_ne_q + dsimp only [toDiv, Pi.add_apply, Pi.smul_apply, Int.zsmul_eq_mul] + simp only [ne_eq, hv_ne_q, not_false_eq_true, one_chip_apply_other', mul_zero, add_zero, + ge_iff_le] + exact c.non_negative v + -- Show there is no nonempty legal set avoiding q + intro S hq hS_nonempty hlegal + have hS_subset : S ⊆ Vtilde q := by + intro v hv_in_S + simp only [Vtilde, Finset.mem_filter, mem_univ, true_and] + exact fun hvq => hq (hvq ▸ hv_in_S) + obtain ⟨v, hv_in_S, hv_outdeg⟩ := h_superstable S hS_subset hS_nonempty + have h_v_ne_q : v ≠ q := by + exact fun hvq => hq (hvq ▸ hv_in_S) + have hge := hlegal v hv_in_S + rw [eval_toDiv_ne_q d c h_v_ne_q] at hge + omega -- Reverse direction intro h_q_reduced S hS_subset hS_nonempty have hq : q ∉ S := by @@ -349,7 +354,7 @@ lemma superstable_iff_q_reduced (G : CFGraph) (q : G.V) (d : ℤ) (c : Config G /-- The canonical configuration of a $q$-reduced divisor is superstable. -/ lemma q_reduced_toConfig_superstable (G : CFGraph) (q : G.V) (D : CFDiv G) - (h_qred : q_reduced G q D) : + (h_qred : qReduced G q D) : superstable G q (toConfig ⟨D, h_qred.1⟩) := by rw [superstable_iff_q_reduced G q (deg D) (toConfig ⟨D, h_qred.1⟩)] simpa only [q_reduced_toDiv_toConfig G q D h_qred] using h_qred @@ -357,14 +362,14 @@ lemma q_reduced_toConfig_superstable (G : CFGraph) (q : G.V) (D : CFDiv G) /-- A divisor is $q$-reduced if and only if it corresponds to a superstable configuration with respect to $q$. -/ lemma q_reduced_superstable_correspondence (G : CFGraph) (q : G.V) (D : CFDiv G) : - q_reduced G q D ↔ ∃ c : Config G q, superstable G q c ∧ + qReduced G q D ↔ ∃ c : Config G q, superstable G q c ∧ D = toDiv (deg D) c := by constructor - . -- Forward direction (q_reduced → ∃ c, superstable ∧ D = c - δ_q) + · -- Forward direction (qReduced → ∃ c, superstable ∧ D = c - δ_q) intro h_qred refine ⟨toConfig ⟨D, h_qred.1⟩, q_reduced_toConfig_superstable G q D h_qred, ?_⟩ exact (q_reduced_toDiv_toConfig G q D h_qred).symm - -- Backward direction (∃ c, superstable ∧ D = c - δ_q → q_reduced) + -- Backward direction (∃ c, superstable ∧ D = c - δ_q → qReduced) · intro h_exists rcases h_exists with ⟨c, h_super, D_eq⟩ rw [D_eq] @@ -374,7 +379,7 @@ lemma q_reduced_superstable_correspondence (G : CFGraph) (q : G.V) (D : CFDiv G) /-- A maximal superstable configuration is not strictly dominated by any other superstable configuration. -/ -def maximal_superstable (G : CFGraph) {q : G.V} (c : Config G q) : Prop := +def maximalSuperstable (G : CFGraph) {q : G.V} (c : Config G q) : Prop := superstable G q c ∧ ∀ c' : Config G q, superstable G q c' → c ≤ c' → c' = c @@ -382,14 +387,14 @@ def maximal_superstable (G : CFGraph) {q : G.V} (c : Config G q) : Prop := divisor. -/ lemma superstable_sub_chip_unwinnable {G : CFGraph} (q : G.V) (c : Config G q) : superstable G q c → - ¬winnable G (c.chips - one_chip q) := by + ¬winnable G (c.chips - oneChip q) := by intro h_superstable - let D := c.chips - one_chip q - have h_red : q_reduced G q D := by + let D := c.chips - oneChip q + have h_red : qReduced G q D := by apply (q_reduced_superstable_correspondence G q D).mpr refine ⟨c, h_superstable, ?_⟩ -- Prove D = c - δ_q - have h_deg_D : deg D = config_degree c - 1 := by + have h_deg_D : deg D = configDegree c - 1 := by dsimp only [D] exact deg_chips_sub_one_chip (c := c) rw [h_deg_D] @@ -413,7 +418,7 @@ out-degree into the vertices that have already burned. The key property is that configuration is superstable if and only if a complete burn list, one containing all vertices, exists (`superstable_burn_list`). -The `burn_flow` function extracts an orientation from a burn list by directing each edge +The `burnFlow` function extracts an orientation from a burn list by directing each edge toward the vertex that appears earlier in the list. This is used to construct the bijection between maximal superstable configurations and acyclic orientations with unique source $q$ (see `Orientation.lean`). @@ -430,30 +435,31 @@ $$ Then $v_i \in S_i$, and the out-degree of $v_i$ with respect to $S_i$, equivalently the number of edges from $v_i$ to the later vertices $\{v_{i+1},\ldots,v_n,q\}$, is greater than the number of chips at $v_i$. -/ -def is_burn_list (G : CFGraph) {q : G.V} (c : Config G q) (L : List G.V) : Prop := +def isBurnList (G : CFGraph) {q : G.V} (c : Config G q) (L : List G.V) : Prop := match L with | [] => False | [x] => (x = q) | v :: w :: rest => - outdeg_S G (univ \ (w :: rest).toFinset) v > c.chips v + outdegS G (univ \ (w :: rest).toFinset) v > c.chips v -- v isn't in the set made out of w :: rest ∧ ¬ (w :: rest).contains v - ∧ is_burn_list G c (w :: rest) + ∧ isBurnList G c (w :: rest) /-- Every burn list contains $q$, since the base case of a burn list is $[q]$. -/ -private lemma burn_list_contains_q (G : CFGraph) {q : G.V} (c : Config G q) (L : List G.V) (h_bl : is_burn_list G c L) : +private lemma burn_list_contains_q (G : CFGraph) {q : G.V} (c : Config G q) (L : List G.V) (h_bl + : isBurnList G c L) : L.contains q := by induction L with | nil => - dsimp only [is_burn_list] at h_bl + dsimp only [isBurnList] at h_bl | cons v rest ih => cases rest with | nil => - dsimp only [is_burn_list] at h_bl + dsimp only [isBurnList] at h_bl rw [h_bl] simp only [List.contains_eq_mem, List.mem_cons, List.not_mem_nil, or_false, decide_true] | cons w rest' => - dsimp only [is_burn_list] at h_bl + dsimp only [isBurnList] at h_bl rcases h_bl with ⟨h_outdeg, h_not_in_rest, h_rest_burn_list⟩ specialize ih h_rest_burn_list simp only [List.contains_eq_mem, List.mem_cons, Bool.decide_or, Bool.or_eq_true, @@ -465,7 +471,9 @@ private lemma burn_list_contains_q (G : CFGraph) {q : G.V} (c : Config G q) (L : /-- If $c$ is superstable and a burn list $L$ does not yet contain all vertices, it can be extended by prepending a new vertex. This corresponds to the next edge burning in Dhar's burning algorithm; superstability implies that the entire graph will burn. -/ -private lemma extend_burn_list (G : CFGraph) {q : G.V} (c : Config G q) (h_ss : superstable G q c) (L : List G.V) : is_burn_list G c L → (∃ v : G.V, ¬ L.contains v) → (∃ w : G.V, w ∉ L.toFinset ∧ is_burn_list G c (w :: L)) := by +private lemma extend_burn_list (G : CFGraph) {q : G.V} (c : Config G q) (h_ss : superstable G q + c) (L : List G.V) : isBurnList G c L → (∃ v : G.V, ¬ L.contains v) → (∃ w : G.V, w ∉ + L.toFinset ∧ isBurnList G c (w :: L)) := by intro h_bl h_exists_v let S := univ \ L.toFinset have h_S_ne : S.Nonempty := by @@ -494,47 +502,50 @@ private lemma extend_burn_list (G : CFGraph) {q : G.V} (c : Config G q) (h_ss : match L with | [] => exfalso - dsimp only [is_burn_list] at h_bl + dsimp only [isBurnList] at h_bl | h :: t => - dsimp only [is_burn_list] + dsimp only [isBurnList] -- Unpack all the conjunctions and use hypotheses one by one constructor - . simp only [List.toFinset_cons, mem_sdiff, mem_univ, mem_insert, List.mem_toFinset, not_or, + · simp only [List.toFinset_cons, mem_sdiff, mem_univ, mem_insert, List.mem_toFinset, not_or, true_and] at hv_in_S simp only [List.toFinset_cons, mem_insert, List.mem_toFinset, not_or] exact hv_in_S constructor - . exact hv_outdeg + · exact hv_outdeg constructor - simp only [List.contains_eq_mem, List.mem_cons, Bool.decide_or, Bool.or_eq_true, - decide_eq_true_eq, not_or] - constructor - intro h - rw [h] at hv_in_S - simp only [List.toFinset_cons, mem_sdiff, mem_univ, mem_insert, List.mem_toFinset, true_or, - not_true_eq_false, and_false] at hv_in_S - simp only [List.toFinset_cons, mem_sdiff, mem_univ, mem_insert, List.mem_toFinset, not_or, - true_and] at hv_in_S - exact hv_in_S.2 + · simp only [List.contains_eq_mem, List.mem_cons, Bool.decide_or, Bool.or_eq_true, + decide_eq_true_eq, not_or] + constructor + · intro h + rw [h] at hv_in_S + simp only [List.toFinset_cons, mem_sdiff, mem_univ, mem_insert, List.mem_toFinset, true_or, + not_true_eq_false, and_false] at hv_in_S + simp only [List.toFinset_cons, mem_sdiff, mem_univ, mem_insert, List.mem_toFinset, not_or, + true_and] at hv_in_S + exact hv_in_S.2 exact h_bl /-- A bundled burn list: a list $L$ of vertices together with a proof that it satisfies the -`is_burn_list` conditions for configuration $c$. -/ -structure burn_list (G : CFGraph) {q : G.V} (c : Config G q) where +`isBurnList` conditions for configuration $c$. -/ +structure burnList (G : CFGraph) {q : G.V} (c : Config G q) where + /-- Ordered list of vertices satisfying the burning condition. -/ (list : List G.V) - (h_burn_list : is_burn_list G c list) + (h_burn_list : isBurnList G c list) /-- For each $n < |V(G)|$, there exists a burn list of size $n+1$. This is the inductive step for `superstable_burn_list`. -/ -private lemma burn_list_helper (G : CFGraph) {q : G.V} (c : Config G q) (h_ss : superstable G q c) (n : ℕ) : (n < Finset.card (univ : Finset G.V))→ ∃ (L : List G.V), L.toFinset.card = n+1 ∧ is_burn_list G c L := by +private lemma burn_list_helper (G : CFGraph) {q : G.V} (c : Config G q) (h_ss : superstable G q + c) (n : ℕ) : (n < Finset.card (univ : Finset G.V))→ ∃ (L : List G.V), L.toFinset.card = n+1 + ∧ isBurnList G c L := by intro h_n_lt_card_V induction n with | zero => use [q] constructor - simp only [List.toFinset_cons, List.toFinset_nil, insert_empty_eq, Finset.card_singleton, - zero_add] - dsimp only [is_burn_list] + · simp only [List.toFinset_cons, List.toFinset_nil, insert_empty_eq, Finset.card_singleton, + zero_add] + dsimp only [isBurnList] | succ n ih => have ih_L : n < (univ : Finset G.V).card := by linarith @@ -551,19 +562,20 @@ private lemma burn_list_helper (G : CFGraph) {q : G.V} (c : Config G q) (h_ss : rcases this with ⟨w, h_w_burn_list⟩ use w :: L constructor - . -- Show cardinality is n+2 + · -- Show cardinality is n+2 rw [List.toFinset_cons] rw [card_insert_eq_ite] -- Need: w ∉ L.toFinset simp only [h_w_burn_list.1, ↓reduceIte, Nat.add_right_cancel_iff] rw [h_L_length] - . -- Show the tail is a burn list + · -- Show the tail is a burn list exact h_w_burn_list.2 /-- A superstable configuration admits a complete burn list containing every vertex of $G$. This is the key output of Dhar's burning algorithm: in a superstable configuration, the whole graph burns. -/ -lemma superstable_burn_list (G : CFGraph) {q : G.V} (c : Config G q) (h_ss : superstable G q c) : ∃ L : burn_list G c, ∀ v : G.V, v ∈ L.list := by +lemma superstable_burn_list (G : CFGraph) {q : G.V} (c : Config G q) (h_ss : superstable G q c) + : ∃ L : burnList G c, ∀ v : G.V, v ∈ L.list := by have h_card_V : (univ : Finset G.V).card ≥ 1 := by have h_nonempty : Nonempty G.V := by infer_instance have h_card_pos : (univ : Finset G.V).card > 0 := Fintype.card_pos_iff.mpr h_nonempty @@ -579,7 +591,7 @@ lemma superstable_burn_list (G : CFGraph) {q : G.V} (c : Config G q) (h_ss : sup simp only [h_L_length, card_univ] apply Nat.sub_add_cancel exact h_card_V - use burn_list.mk L h_L_burn_list + use burnList.mk L h_L_burn_list have h_toFinset_eq : L.toFinset = (univ : Finset G.V) := by refine Finset.eq_of_subset_of_card_le (Finset.subset_univ _) ?_ simp only [card_univ, h_L_card, Std.le_refl] @@ -594,50 +606,53 @@ lemma superstable_burn_list (G : CFGraph) {q : G.V} (c : Config G q) (h_ss : sup (i.e. assign nonzero flow) if $u$ appears in the list and $v$ appears before $u$. In other words, the orientation indicates the direction of the spreading fire in Dhar's burning algorithm. -/ -def burn_flow {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) : (G.V × G.V) → ℕ := - λ e => if (e.1 ∈ L.list) ∧ (L.list.idxOf e.2 < L.list.idxOf e.1) then num_edges G e.1 e.2 else 0 +def burnFlow {G : CFGraph} {q : G.V} {c : Config G q} (L : burnList G c) : (G.V × G.V) → ℕ := + fun e => if (e.1 ∈ L.list) ∧ (L.list.idxOf e.2 < L.list.idxOf e.1) then numEdges G e.1 e.2 else 0 -/-- The `burn_flow` of a complete burn list is a valid orientation: for every edge -$\{u,v\}$, exactly `num_edges G u v` units of flow are directed in one of the two +/-- The `burnFlow` of a complete burn list is a valid orientation: for every edge +$\{u,v\}$, exactly `numEdges G u v` units of flow are directed in one of the two directions. -/ -lemma burn_flow_reverse {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (h_full : ∀ v : G.V, v ∈ L.list) : ∀ (u v : G.V), (burn_flow L ⟨u, v⟩) + (burn_flow L ⟨v, u⟩) = num_edges G u v := by +lemma burn_flow_reverse {G : CFGraph} {q : G.V} {c : Config G q} (L : burnList G c) (h_full : ∀ + v : G.V, v ∈ L.list) : ∀ (u v : G.V), (burnFlow L ⟨u, v⟩) + (burnFlow L ⟨v, u⟩) = numEdges G + u v := by intro u v - dsimp only [burn_flow] + dsimp only [burnFlow] by_cases h_uv : L.list.idxOf v < L.list.idxOf u - . -- Case: indexOf v < indexOf u + · -- Case: indexOf v < indexOf u simp only [h_full u, h_uv, and_self, ↓reduceIte, h_full v, true_and, Nat.add_eq_left, ite_eq_right_iff] intro h linarith - . -- Case: indexOf v ≥ indexOf u + · -- Case: indexOf v ≥ indexOf u by_cases h_eq : L.list.idxOf u = L.list.idxOf v - . -- Subcase: indexOf u < indexOf v + · -- Subcase: indexOf u < indexOf v simp only [h_eq, lt_self_iff_false, and_false, ↓reduceIte, add_zero] have : u = v := (List.idxOf_inj (h_full u)).mp h_eq rw [this, num_edges_self_zero G v] - . -- Subcase: indexOf u > indexOf v + · -- Subcase: indexOf u > indexOf v have h_uv' : L.list.idxOf u < L.list.idxOf v := by simp only [not_lt] at h_uv h_eq exact lt_of_le_of_ne h_uv h_eq simp only [h_uv, and_false, ↓reduceIte, h_full v, h_uv', and_self, zero_add] exact num_edges_symmetric G v u -/-- The `burn_flow` of a complete burn list is directed: for every pair $(u,v)$, flow goes +/-- The `burnFlow` of a complete burn list is directed: for every pair $(u,v)$, flow goes in at most one direction. -/ -lemma burn_flow_directed {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (h_full : ∀ v : G.V, v ∈ L.list) : ∀ (u v : G.V), burn_flow L ⟨u,v⟩ = 0 ∨ burn_flow L ⟨v,u⟩ = 0 := by +lemma burn_flow_directed {G : CFGraph} {q : G.V} {c : Config G q} (L : burnList G c) (h_full : ∀ + v : G.V, v ∈ L.list) : ∀ (u v : G.V), burnFlow L ⟨u,v⟩ = 0 ∨ burnFlow L ⟨v,u⟩ = 0 := by intro u v - dsimp only [burn_flow] + dsimp only [burnFlow] by_cases h_uv : L.list.idxOf v < L.list.idxOf u - . -- Case: indexOf v < indexOf u + · -- Case: indexOf v < indexOf u simp only [h_full u, h_uv, and_self, ↓reduceIte, h_full v, true_and, ite_eq_right_iff] right intro h linarith - . -- Case: indexOf v ≥ indexOf u + · -- Case: indexOf v ≥ indexOf u by_cases h_eq : L.list.idxOf u = L.list.idxOf v - . -- Subcase: indexOf u = indexOf v + · -- Subcase: indexOf u = indexOf v simp only [h_eq, lt_self_iff_false, and_false, ↓reduceIte, or_self] - . -- Subcase: indexOf u > indexOf v + · -- Subcase: indexOf u > indexOf v have h_uv' : L.list.idxOf u < L.list.idxOf v := by simp only [not_lt] at h_uv h_eq exact lt_of_le_of_ne h_uv h_eq @@ -646,18 +661,19 @@ lemma burn_flow_directed {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list /-- For any vertex $v \ne q$ in a burn list, the in-flow into $v$ exceeds the number of chips at $v$. This is the key inequality used to construct an acyclic orientation from a superstable configuration. -/ -lemma burnin_degree {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (v : G.V) (h_pres : v ∈ L.list) (h_ne : v ≠ q): ∑ (w : G.V), burn_flow L ⟨w,v⟩ > c.chips v := by +lemma burnin_degree {G : CFGraph} {q : G.V} {c : Config G q} (L : burnList G c) (v : G.V) + (h_pres : v ∈ L.list) (h_ne : v ≠ q) : ∑ (w : G.V), burnFlow L ⟨w,v⟩ > c.chips v := by let h_bl := L.h_burn_list cases h: L.list with | nil => rw [h] at h_bl - dsimp only [is_burn_list] at h_bl + dsimp only [isBurnList] at h_bl | cons x rest => cases h' : rest with | nil => rw [h'] at h rw [h] at h_bl - dsimp only [is_burn_list] at h_bl + dsimp only [isBurnList] at h_bl -- So x = q simp only [h, List.mem_cons, List.not_mem_nil, or_false] at h_pres rw [h_pres, ← h_bl] at h_ne @@ -665,14 +681,14 @@ lemma burnin_degree {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) | cons y rest' => rw [h'] at h rw [h] at h_bl - dsimp only [is_burn_list] at h_bl + dsimp only [isBurnList] at h_bl -- Need to analyze the position of v in the list by_cases h_vx : v = x - . -- Case: v = x + · -- Case: v = x rw [← h_vx] at h_bl - suffices ∑ (w : G.V), burn_flow L ⟨w,v⟩ ≥ outdeg_S G (univ \ (y :: rest').toFinset) v by + suffices ∑ (w : G.V), burnFlow L ⟨w,v⟩ ≥ outdegS G (univ \ (y :: rest').toFinset) v by linarith [this, h_bl.1] - dsimp only [burn_flow] + dsimp only [burnFlow] have ind_v : L.list.idxOf v = 0 := by rw [h_vx,h] simp only [List.idxOf_cons_self] @@ -685,10 +701,10 @@ lemma burnin_degree {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) simp only [List.mem_cons] have : 0 < List.idxOf w (x :: rest) ↔ 0 ≠ List.idxOf w (x :: rest) := by constructor - . intro h_pos h_eq + · intro h_pos h_eq rw [h_eq] at h_pos linarith - . intro h_neq + · intro h_neq simp only [ne_eq] at h_neq apply Nat.zero_lt_of_ne_zero contrapose! h_neq with h_eq_zero @@ -696,21 +712,21 @@ lemma burnin_degree {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) rw [this] have : 0 ≠ List.idxOf w (x :: rest) ↔ w ≠ x := by constructor - . intro h_neq + · intro h_neq contrapose! h_neq with h_eq rw [h_eq] simp only [List.idxOf_cons_self] - . intro h_neq + · intro h_neq rw [List.idxOf_cons_ne _ (Ne.symm h_neq)] simp only [Nat.succ_eq_add_one, ne_eq, Nat.right_eq_add, Nat.add_eq_zero_iff, one_ne_zero, and_false, not_false_eq_true] rw [this] constructor - . -- Forward direction + · -- Forward direction intro h_w by_contra! simp only [this, or_false, ne_eq, and_not_self] at h_w - . -- Reverse direction + · -- Reverse direction intro h_w_in_rest simp only [h_w_in_rest, or_true, ne_eq, true_and] by_contra! @@ -721,7 +737,7 @@ lemma burnin_degree {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) absurd this simp only [List.contains_eq_mem, h_w_in_rest, decide_true] simp only [h_above] - dsimp only [outdeg_S] + dsimp only [outdegS] rw [← h'] rw [Finset.sum_ite, Finset.sum_const_zero, add_zero] simp only [Nat.cast_sum, sdiff_sdiff_right_self, subset_univ, inf_of_le_right, ge_iff_le] @@ -732,8 +748,8 @@ lemma burnin_degree {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) apply sum_le_sum intro i _ rw [num_edges_symmetric G i v] - . -- Case: v ≠ x - let L' := burn_list.mk (y :: rest') (h_bl.2.2) + · -- Case: v ≠ x + let L' := burnList.mk (y :: rest') (h_bl.2.2) have h_v_in_L' : v ∈ L'.list := by dsimp only [L'] rw [← h'] @@ -741,7 +757,7 @@ lemma burnin_degree {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) rw [h] at h_pres simp only [List.mem_cons, h_vx, false_or] at h_pres exact h_pres - have h_step : ∀ (w : G.V), burn_flow L ⟨w,v⟩ = burn_flow L' ⟨w,v⟩ := by + have h_step : ∀ (w : G.V), burnFlow L ⟨w,v⟩ = burnFlow L' ⟨w,v⟩ := by have h_x_nin_rest: x ∉ rest := by have := L.h_burn_list rw [h] at this @@ -751,16 +767,16 @@ lemma burnin_degree {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) decide_eq_true_eq, not_or] at this simp only [List.mem_cons, this, or_self, not_false_eq_true] intro w - dsimp only [burn_flow, L'] + dsimp only [burnFlow, L'] rw [h] rw [List.idxOf_cons_ne _ (Ne.symm h_vx)] by_cases h_wx : w = x - . -- Subcase: w = x + · -- Subcase: w = x rw [h_wx] have h0 : (x :: y :: rest').idxOf x = 0 := List.idxOf_cons_self rw [h0, ite_eq_right (fun ⟨_, h⟩ => Nat.not_lt_zero _ h), ite_eq_right (fun ⟨h_mem, _⟩ => (h' ▸ h_x_nin_rest) h_mem)] - . -- Subcase: w ≠ x + · -- Subcase: w ≠ x simp only [List.mem_cons, h_wx, false_or] rw [List.idxOf_cons_ne (y :: rest') (Ne.symm h_wx)] simp only [Nat.succ_lt_succ_iff] diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean index 6314f8e9eb..9ecd2523f8 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean @@ -6,9 +6,6 @@ Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger import LeanPool.ChipFiring.ChipFiringWithLean.Config import Mathlib.Data.DFinsupp.Multiset - -open Multiset Finset - /-! ## Orientations of chip-firing graphs @@ -19,7 +16,7 @@ An *orientation* (`CFOrientation G`) assigns a direction to each edge of $G$. Th objects are: - `indeg G O v`: the in-degree of vertex $v$ under orientation $\mathcal{O}$. - `ordiv G O`: the divisor $D(\mathcal{O})$ assigning $\mathrm{indeg}(v) - 1$ to each vertex. -- `orientation_to_config G O q`: the configuration $c(\mathcal{O})$ for acyclic orientations +- `orientationToConfig G O q`: the configuration $c(\mathcal{O})$ for acyclic orientations with unique source $q$. The main results are: @@ -34,37 +31,43 @@ The main results are: See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 4.8. -/ + +open Multiset Finset + + + /-- An *orientation* of $G$ assigns a direction to each edge. -The field `directed_edges` is a multiset of directed pairs. The `count_preserving` field +The field `directedEdges` is a multiset of directed pairs. The `count_preserving` field ensures that the total flow between $v$ and $w$ equals the edge multiplicity, and -/ structure CFOrientation (G : CFGraph) where /-- The multiset of directed edges in the orientation. -/ - directed_edges : Multiset (G.V × G.V) + directedEdges : Multiset (G.V × G.V) /-- The total directed flow between two vertices preserves the graph's edge multiplicity. -/ count_preserving : ∀ v w, - num_edges G v w = - Multiset.count (v, w) directed_edges + Multiset.count (w, v) directed_edges + numEdges G v w = + Multiset.count (v, w) directedEdges + Multiset.count (w, v) directedEdges /-- The flow from $u$ to $v$ under an orientation $\mathcal{O}$ is the multiplicity of the directed edge $(u,v)$. -/ -abbrev flow {G: CFGraph} (O : CFOrientation G) (u v : G.V) : ℕ := - Multiset.count (u,v) O.directed_edges +abbrev flow {G : CFGraph} (O : CFOrientation G) (u v : G.V) : ℕ := + Multiset.count (u,v) O.directedEdges /-- The total flow on an undirected edge equals its multiplicity. -/ private lemma opp_flow {G : CFGraph} (O : CFOrientation G) (u v : G.V) : - flow O u v + flow O v u= (num_edges G u v) := by + flow O u v + flow O v u= (numEdges G u v) := by rw[O.count_preserving u v] /-- Two orientations are equal if and only if they assign the same flow to every directed pair. -/ -private lemma eq_orient {G : CFGraph} (O1 O2 : CFOrientation G) : O1 = O2 ↔ ∀ (u v : G.V), flow O1 u v = flow O2 u v := by +private lemma eq_orient {G : CFGraph} (O1 O2 : CFOrientation G) : O1 = O2 ↔ ∀ (u v : G.V), flow + O1 u v = flow O2 u v := by constructor · intro h_eq u v rw [h_eq] -- Converse · intro h_flow_eq - have h_directed_edges_eq : O1.directed_edges = O2.directed_edges := by + have h_directed_edges_eq : O1.directedEdges = O2.directedEdges := by apply Multiset.ext.mpr intro ⟨u,v⟩ specialize h_flow_eq u v @@ -75,28 +78,31 @@ private lemma eq_orient {G : CFGraph} (O1 O2 : CFOrientation G) : O1 = O2 ↔ rfl /-- Rewrites a double sum over a finite type as a sum over ordered pairs. -/ -private lemma double_sum {T : Type*} [DecidableEq T] [Fintype T] (f : T × T → ℕ) : +private lemma double_sum {T : Type*} [Fintype T] (f : T × T → ℕ) : ∑ (u : T), ∑ (v : T), f ⟨u, v⟩ = ∑ (e : T × T), f e := by rw [← Finset.sum_product] simp only [univ_product_univ] /-- The multiset of directed edges in an orientation has the same cardinality as the underlying multiset of graph edges. -/ -private lemma card_directed_edges_eq_card_edges {G : CFGraph} (O : CFOrientation G) : Multiset.card O.directed_edges = Multiset.card G.edges := by +private lemma card_directed_edges_eq_card_edges {G : CFGraph} (O : CFOrientation G) : + Multiset.card O.directedEdges = Multiset.card G.edges := by have hms (M : Multiset (G.V × G.V)): ∀ e ∈ M, e ∈ univ := by intro e _ exact mem_univ e - let f (u v : G.V) := flow O u v let g (u v : G.V) := Multiset.count ⟨u,v⟩ G.edges have h_uv (u v : G.V) : f u v + f v u = g u v + g v u := by have h := O.count_preserving u v dsimp only [flow, f, g] - dsimp only [num_edges] at h + dsimp only [numEdges] at h rw [← h] - rw [← Multiset.sum_count_eq_card (hms ((Multiset.filter (fun e ↦ e = (u, v) ∨ e = (v, u)) G.edges)))] + rw [← Multiset.sum_count_eq_card (hms ((Multiset.filter (fun e ↦ e = (u, v) ∨ e = (v, u)) + G.edges)))] -- Now simplify the count of a in the filtered multiset - have h_msum (u v : G.V) : Multiset.filter (λ e => e = (u, v) ∨ e = (v, u)) G.edges = Multiset.filter (λ e => e = ⟨u,v⟩) G.edges + Multiset.filter (λ e => e = ⟨v,u⟩) G.edges := by + have h_msum (u v : G.V) : Multiset.filter (fun e => e = (u, v) ∨ e = (v, u)) G.edges = + Multiset.filter (fun e => e = ⟨u,v⟩) G.edges + Multiset.filter (fun e => e = ⟨v,u⟩) + G.edges := by apply Multiset.ext.mpr intro e simp only [count_add] @@ -122,12 +128,12 @@ private lemma card_directed_edges_eq_card_edges {G : CFGraph} (O : CFOrientation simp only [count_add] rw [sum_add_distrib] simp only [count_filter, sum_ite_eq', mem_univ, ↓reduceIte] - have lhs : ∑ u: G.V, ∑ v : G.V, (f u v + f v u)= 2 * Multiset.card O.directed_edges := by + have lhs : ∑ u: G.V, ∑ v : G.V, (f u v + f v u)= 2 * Multiset.card O.directedEdges := by simp only [sum_add_distrib] dsimp only [flow, f] nth_rewrite 2 [Finset.sum_comm] rw [← two_mul] - have h_replace := double_sum (λ e : G.V × G.V => Multiset.count e O.directed_edges) + have h_replace := double_sum (fun e : G.V × G.V => Multiset.count e O.directedEdges) simp only [h_replace] simp only [mem_univ, implies_true, sum_count_eq_card] have rhs : ∑ u : G.V, ∑ v : G.V, (g u v + g v u) = 2 * Multiset.card G.edges := by @@ -135,7 +141,7 @@ private lemma card_directed_edges_eq_card_edges {G : CFGraph} (O : CFOrientation dsimp only [g] nth_rewrite 2 [Finset.sum_comm] rw [← two_mul] - have h_replace := double_sum (λ e : G.V × G.V => Multiset.count e G.edges) + have h_replace := double_sum (fun e : G.V × G.V => Multiset.count e G.edges) simp only [h_replace] simp only [mem_univ, implies_true, sum_count_eq_card] simp only [h_uv] at lhs @@ -144,15 +150,15 @@ private lemma card_directed_edges_eq_card_edges {G : CFGraph} (O : CFOrientation /-- The number of edges directed into a vertex under an orientation. -/ def indeg (G : CFGraph) (O : CFOrientation G) (v : G.V) : ℕ := - Multiset.card (O.directed_edges.filter (λ e => e.snd = v)) + Multiset.card (O.directedEdges.filter (fun e => e.snd = v)) /-- The in-degree of $v$ equals the sum of flows into $v$ from all vertices. -/ private lemma indeg_eq_sum_flow {G : CFGraph} (O : CFOrientation G) (v : G.V) : indeg G O v = ∑ w : G.V, flow O w v := by dsimp only [indeg, flow] suffices h_eq : (∀ S : Multiset (G.V × G.V) , ∀ v : G.V, - Multiset.card (S.filter (λ e => e.snd = v)) = ∑ u : G.V, Multiset.count (u, v) S) by - exact h_eq O.directed_edges v + Multiset.card (S.filter (fun e => e.snd = v)) = ∑ u : G.V, Multiset.count (u, v) S) by + exact h_eq O.directedEdges v -- Prove by induction on the set of directed edges, following the pattern of the proof of -- degree_eq_total_flow in Basic.lean. I suspect the two can be unified. intro S v @@ -187,16 +193,16 @@ private lemma indeg_eq_sum_flow {G : CFGraph} (O : CFOrientation G) (v : G.V) : /-- The number of edges directed out of a vertex under an orientation. -/ def outdeg (G : CFGraph) (O : CFOrientation G) (v : G.V) : ℕ := - Multiset.card (O.directed_edges.filter (λ e => e.fst = v)) + Multiset.card (O.directedEdges.filter (fun e => e.fst = v)) /-- A vertex is a source if it has no incoming edges. -/ -def is_source (G : CFGraph) (O : CFOrientation G) (v : G.V) : Prop := +def isSource (G : CFGraph) (O : CFOrientation G) (v : G.V) : Prop := indeg G O v = 0 -/-- The proposition `directed_edge G O u v` holds when there is a directed edge from $u$ +/-- The proposition `directedEdge G O u v` holds when there is a directed edge from $u$ to $v$ in orientation $\mathcal{O}$. -/ -def directed_edge (G : CFGraph) (O : CFOrientation G) (u v : G.V) : Prop := - (u, v) ∈ O.directed_edges +def directedEdge (G : CFGraph) (O : CFOrientation G) (u v : G.V) : Prop := + (u, v) ∈ O.directedEdges /-- A directed path in a graph under an orientation. -/ structure DirectedPath {G : CFGraph} (O : CFOrientation G) where @@ -205,34 +211,34 @@ structure DirectedPath {G : CFGraph} (O : CFOrientation G) where /-- The path is nonempty. -/ non_empty : vertices.length > 0 /-- Every consecutive pair forms a directed edge. -/ - valid_edges : List.IsChain (directed_edge G O) vertices + valid_edges : List.IsChain (directedEdge G O) vertices /-- A directed path is *non-repeating* if its vertex list has no duplicates. -/ -def non_repeating {G: CFGraph} {O : CFOrientation G} (p : DirectedPath O) : Prop := +def nonRepeating {G : CFGraph} {O : CFOrientation G} (p : DirectedPath O) : Prop := p.vertices.Nodup /-- A non-repeating directed path has length at most $|V(G)|$. -/ private lemma path_length_bound {G : CFGraph} {O : CFOrientation G} (p : DirectedPath O) : - non_repeating p → p.vertices.length ≤ Fintype.card G.V := by + nonRepeating p → p.vertices.length ≤ Fintype.card G.V := by intro h_distinct exact List.Nodup.length_le_card h_distinct /-- An orientation is acyclic if every directed path has no repeated vertices. -/ -def is_acyclic (G : CFGraph) (O : CFOrientation G) : Prop := - ∀ (p : DirectedPath O), non_repeating p +def isAcyclic (G : CFGraph) (O : CFOrientation G) : Prop := + ∀ (p : DirectedPath O), nonRepeating p /-- Vertices that are not sources must have at least one incoming edge. -/ private lemma indeg_ge_one_of_not_source (G : CFGraph) (O : CFOrientation G) (v : G.V) : - ¬ is_source G O v → indeg G O v ≥ 1 := by - intro h_not_source -- h_not_source : is_source G O v = false - unfold is_source at h_not_source -- h_not_source : (decide (indeg G O v = 0)) = false + ¬ isSource G O v → indeg G O v ≥ 1 := by + intro h_not_source -- h_not_source : isSource G O v = false + unfold isSource at h_not_source -- h_not_source : (decide (indeg G O v = 0)) = false apply Nat.one_le_iff_ne_zero.mpr -- Goal is indeg G O v ≠ 0 intro h_eq_zero -- Assume indeg G O v = 0 exact h_not_source h_eq_zero /-- For vertices that are not sources, $\mathrm{indeg}(v)-1$ is nonnegative. -/ private lemma indeg_minus_one_nonneg_of_not_source (G : CFGraph) (O : CFOrientation G) (v : G.V) : - ¬ is_source G O v → 0 ≤ (indeg G O v : ℤ) - 1 := by + ¬ isSource G O v → 0 ≤ (indeg G O v : ℤ) - 1 := by intro h_not_source have h_indeg_ge_1 : indeg G O v ≥ 1 := indeg_ge_one_of_not_source G O v h_not_source apply Int.sub_nonneg_of_le @@ -241,14 +247,12 @@ private lemma indeg_minus_one_nonneg_of_not_source (G : CFGraph) (O : CFOrientat /-- In an acyclic orientation, every nonempty subset of vertices contains a vertex with no incoming flow from within the subset (a relative source). -/ -private lemma subset_source (G : CFGraph) (O : CFOrientation G) (S : Finset G.V): - S.Nonempty → is_acyclic G O → ∃ v ∈ S, ∀ w ∈ S, flow O w v = 0 := by +private lemma subset_source (G : CFGraph) (O : CFOrientation G) (S : Finset G.V) : + S.Nonempty → isAcyclic G O → ∃ v ∈ S, ∀ w ∈ S, flow O w v = 0 := by intro S_nonempty h_acyclic by_contra! no_sourceless - let S_path (p : DirectedPath O) : Prop := ∀ v ∈ p.vertices, v ∈ S - have arb_path (n : ℕ) : ∃ (p : DirectedPath O), S_path p ∧ p.vertices.length = n + 1:= by induction n with | zero => @@ -302,11 +306,11 @@ private lemma subset_source (G : CFGraph) (O : CFOrientation G) (S : Finset G.V) rw [← eq_vv'] constructor -- Show the new first link is a directed edge - have := h_u.2 - dsimp only [flow, ne_eq] at this - contrapose! this with h_no_edge - simp only [count_eq_zero] - exact h_no_edge + · have := h_u.2 + dsimp only [flow, ne_eq] at this + contrapose! this with h_no_edge + simp only [count_eq_zero] + exact h_no_edge -- Now show the rest of the path is valid have h_rec := p.valid_edges rw [h_case] at h_rec @@ -315,14 +319,14 @@ private lemma subset_source (G : CFGraph) (O : CFOrientation G) (S : Finset G.V) } -- Show that the path lies in S constructor - intro v h_v_in_path - simp only at h_v_in_path - dsimp only [new_path] at h_v_in_path - cases h_v_in_path with - | head h_eq_v => - exact h_u.1 - | tail _ h_v_in_tail => - exact h_len.1 v h_v_in_tail + · intro v h_v_in_path + simp only at h_v_in_path + dsimp only [new_path] at h_v_in_path + cases h_v_in_path with + | head h_eq_v => + exact h_u.1 + | tail _ h_v_in_tail => + exact h_len.1 v h_v_in_tail -- Show the length is n + 2 rw [List.length_cons] rw [h_len.2] @@ -333,49 +337,50 @@ private lemma subset_source (G : CFGraph) (O : CFOrientation G) (S : Finset G.V) /-- A nonempty graph with an acyclic orientation has at least one source. -/ private lemma acyclic_has_source (G : CFGraph) (O : CFOrientation G) : - is_acyclic G O → ∃ v : G.V, is_source G O v := by + isAcyclic G O → ∃ v : G.V, isSource G O v := by intro h_acyclic have h := subset_source G O Finset.univ Finset.univ_nonempty h_acyclic rcases h with ⟨v, _, h_source⟩ use v - dsimp only [is_source] + dsimp only [isSource] rw [indeg_eq_sum_flow] apply Finset.sum_eq_zero exact h_source /-- If every source of an acyclic orientation must equal $q$, then $q$ is itself a source. -/ -private lemma is_source_of_unique_source {G : CFGraph} (O : CFOrientation G) {q : G.V} (h_acyclic : is_acyclic G O) - (h_unique_source : ∀ w, is_source G O w → w = q) : - is_source G O q := by +private lemma is_source_of_unique_source {G : CFGraph} (O : CFOrientation G) {q : G.V} + (h_acyclic : isAcyclic G O) + (h_unique_source : ∀ w, isSource G O w → w = q) : + isSource G O q := by rcases acyclic_has_source G O h_acyclic with ⟨q', h_q'⟩ specialize h_unique_source q' have := h_unique_source h_q' rw [this] at h_q' exact h_q' -/-- The proposition `acyclic_with_unique_source G O q` means that $\mathcal{O}$ is acyclic +/-- The proposition `acyclicWithUniqueSource G O q` means that $\mathcal{O}$ is acyclic and every source of $\mathcal{O}$ is equal to $q$. -/ -def acyclic_with_unique_source (G : CFGraph) (O : CFOrientation G) (q : G.V) : Prop := - is_acyclic G O ∧ ∀ w, is_source G O w → w = q +def acyclicWithUniqueSource (G : CFGraph) (O : CFOrientation G) (q : G.V) : Prop := + isAcyclic G O ∧ ∀ w, isSource G O w → w = q /-- In an acyclic orientation with unique source $q$, the vertex $q$ is a source. -/ private lemma source_of_acyclic_with_unique_source {G : CFGraph} {O : CFOrientation G} {q : G.V} - (hO : acyclic_with_unique_source G O q) : is_source G O q := + (hO : acyclicWithUniqueSource G O q) : isSource G O q := is_source_of_unique_source O hO.1 hO.2 /-- The configuration associated to an acyclic orientation with unique source $q$ assigns $\mathrm{indeg}(v)-1$ chips to each vertex $v \ne q$, and $0$ at $q$. -/ -def config_of_source {G : CFGraph} {O : CFOrientation G} {q : G.V} - (hO : acyclic_with_unique_source G O q) : Config G q := - { chips := λ v => if v = q then 0 else (indeg G O v : ℤ) - 1, +def configOfSource {G : CFGraph} {O : CFOrientation G} {q : G.V} + (hO : acyclicWithUniqueSource G O q) : Config G q := + { chips := fun v => if v = q then 0 else (indeg G O v : ℤ) - 1, q_zero := by simp only [↓reduceIte] non_negative := by intro v simp only [ge_iff_le] split_ifs with h_eq · linarith - · have h_not_source : ¬ is_source G O v := by + · have h_not_source : ¬ isSource G O v := by intro hs_v exact h_eq (hO.2 v hs_v) exact indeg_minus_one_nonneg_of_not_source G O v h_not_source @@ -388,7 +393,7 @@ For an orientation $\mathcal{O}$ of $G$, the *orientation divisor* `ordiv G O` i $D(\mathcal{O})(v) = \mathrm{indeg}_{\mathcal{O}}(v) - 1$. For an acyclic orientation $\mathcal{O}$ with unique source $q$, the associated -*configuration* `orientation_to_config G O q` assigns $\mathrm{indeg}(v) - 1$ chips to +*configuration* `orientationToConfig G O q` assigns $\mathrm{indeg}(v) - 1$ chips to each vertex $v \ne q$. An acyclic orientation is uniquely determined by its in-degree sequence (`orientation_determined_by_indegrees`), and the divisor of an acyclic orientation is always $q$-reduced and unwinnable. @@ -401,12 +406,12 @@ See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 4.7. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 4.7, part 1; written $D(\mathcal{O})$ there. -/ def ordiv (G : CFGraph) (O : CFOrientation G) : CFDiv G := - λ v => indeg G O v - 1 + fun v => indeg G O v - 1 /-- The orientation divisor `ordiv G O` bundled as a $q$-effective divisor, using acyclicity to prove $q$-effectivity. -/ def orqed {G : CFGraph} (O : CFOrientation G) {q : G.V} - (hO : acyclic_with_unique_source G O q) : q_eff_div G q := { + (hO : acyclicWithUniqueSource G O q) : qEffDiv G q := { D := ordiv G O, h_eff := by intro v v_ne_q @@ -418,7 +423,7 @@ def orqed {G : CFGraph} (O : CFOrientation G) {q : G.V} -- Sum of non-negative terms is zero, so each term is zero apply hO.2 contrapose! h_indeg with h_not_source - dsimp only [is_source] at h_not_source + dsimp only [isSource] at h_not_source rw [indeg_eq_sum_flow] at h_not_source intro h_bad rw [h_bad] at h_not_source @@ -429,18 +434,18 @@ def orqed {G : CFGraph} (O : CFOrientation G) {q : G.V} See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 4.7 (part 2). -/ -def orientation_to_config (G : CFGraph) (O : CFOrientation G) (q : G.V) - (hO : acyclic_with_unique_source G O q) : Config G q := - config_of_source hO +def orientationToConfig (G : CFGraph) (O : CFOrientation G) (q : G.V) + (hO : acyclicWithUniqueSource G O q) : Config G q := + configOfSource hO /-- The configuration associated to an orientation records the expected in-degree data. -/ private lemma orientation_to_config_indeg (G : CFGraph) (O : CFOrientation G) (q : G.V) - (hO : acyclic_with_unique_source G O q) (v : G.V) : - (orientation_to_config G O q hO).chips v = + (hO : acyclicWithUniqueSource G O q) (v : G.V) : + (orientationToConfig G O q hO).chips v = if v = q then 0 else (indeg G O v : ℤ) - 1 := by - -- This follows directly from the definition of config_of_source - simp only [orientation_to_config] at * - -- Use the definition of config_of_source + -- This follows directly from the definition of configOfSource + simp only [orientationToConfig] at * + -- Use the definition of configOfSource exact rfl @@ -448,9 +453,9 @@ private lemma orientation_to_config_indeg (G : CFGraph) (O : CFOrientation G) (q /-- The configuration associated to an orientation agrees with the configuration obtained from its orientation divisor. -/ lemma config_and_divisor_from_O {G : CFGraph} (O : CFOrientation G) {q : G.V} - (hO : acyclic_with_unique_source G O q) : - orientation_to_config G O q hO = toConfig (orqed O hO) := by - let c := orientation_to_config G O q hO + (hO : acyclicWithUniqueSource G O q) : + orientationToConfig G O q hO = toConfig (orqed O hO) := by + let c := orientationToConfig G O q hO let D := orqed O hO rw [eq_config_iff_eq_chips] funext v @@ -461,7 +466,7 @@ lemma config_and_divisor_from_O {G : CFGraph} (O : CFOrientation G) {q : G.V} rw [c.q_zero, d.q_zero] rw [this] · -- Case v ≠ q - dsimp only [orientation_to_config, config_of_source, orqed, toConfig, ordiv, Pi.sub_apply, + dsimp only [orientationToConfig, configOfSource, orqed, toConfig, ordiv, Pi.sub_apply, Pi.smul_apply, Int.zsmul_eq_mul] simp only [h_v, ↓reduceIte, ne_eq, not_false_eq_true, one_chip_apply_other', mul_zero, sub_zero] @@ -477,12 +482,11 @@ lemma config_and_divisor_from_O {G : CFGraph} (O : CFOrientation G) {q : G.V} See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Lemma 4.3. -/ lemma orientation_determined_by_indegrees {G : CFGraph} (O O' : CFOrientation G) : - is_acyclic G O → is_acyclic G O' → + isAcyclic G O → isAcyclic G O' → (∀ v : G.V, indeg G O v = indeg G O' v) → O = O' := by intro h_acyc h_acyc' h_indeg_eq - - let S := { e : G.V × G.V | O.directed_edges.count e > O'.directed_edges.count e } + let S := { e : G.V × G.V | O.directedEdges.count e > O'.directedEdges.count e } have suff_S_empty : S = ∅ → O = O' := by intro h_S_empty have h_ineq (u v : G.V) : flow O u v ≤ flow O' u v := by @@ -499,23 +503,21 @@ lemma orientation_determined_by_indegrees {G : CFGraph} have h_indeg_contra : indeg G O v < indeg G O' v := by rw [indeg_eq_sum_flow O v, indeg_eq_sum_flow O' v] apply Finset.sum_lt_sum - intro x hx - exact h_ineq x v + · intro x hx + exact h_ineq x v use u simp only [mem_univ, h_lt, and_self] linarith [h_indeg_eq v] apply suff_S_empty - -- A small helper we'll need a couple time later - have directed_edge_of_S (e : G.V × G.V) : e ∈ S → directed_edge G O e.1 e.2 := by - dsimp only [directed_edge] + have directed_edge_of_S (e : G.V × G.V) : e ∈ S → directedEdge G O e.1 e.2 := by + dsimp only [directedEdge] intro h dsimp only [Set.mem_ofPred_eq, S] at h - have h_pos_count : count e O.directed_edges > 0 := by + have h_pos_count : count e O.directedEdges > 0 := by omega apply Multiset.count_pos.mp exact h_pos_count - -- We now must show that S is empty. -- Do so by showing any element in S belongs to an infinite directed path have going_up : ∀ e ∈ S, ∃ f ∈ S, f.2 = e.1 := by @@ -539,21 +541,18 @@ lemma orientation_determined_by_indegrees {G : CFGraph} have edges_lt := add_lt_add_of_le_of_lt h_e_in_S flow_lt rw [opp_flow O v u, opp_flow O' v u] at edges_lt linarith - have h: ∑ (w : G.V), flow O w u < ∑ (w : G.V), flow O' w u := by apply Finset.sum_lt_sum - intro i _ - exact all_flow_le i + · intro i _ + exact all_flow_le i rcases one_flow_lt with ⟨w, h_flow_lt⟩ use w constructor - simp only [mem_univ] + · simp only [mem_univ] exact h_flow_lt - repeat rw [← indeg_eq_sum_flow] at h specialize h_indeg_eq u linarith - -- Suppose S is nonempty, and consider the set T of vertices where an edge of S -- originates. By going_up, every vertex of T receives positive flow from another -- vertex of T, contradicting the relative source provided by subset_source. @@ -581,21 +580,18 @@ lemma orientation_determined_by_indegrees {G : CFGraph} private theorem config_to_orientation_unique (G : CFGraph) (q : G.V) (c : Config G q) (O₁ O₂ : CFOrientation G) - (hO₁ : acyclic_with_unique_source G O₁ q) - (hO₂ : acyclic_with_unique_source G O₂ q) - (h_eq₁ : orientation_to_config G O₁ q hO₁ = c) - (h_eq₂ : orientation_to_config G O₂ q hO₂ = c) : + (hO₁ : acyclicWithUniqueSource G O₁ q) + (hO₂ : acyclicWithUniqueSource G O₂ q) + (h_eq₁ : orientationToConfig G O₁ q hO₁ = c) + (h_eq₂ : orientationToConfig G O₂ q hO₂ = c) : O₁ = O₂ := by apply orientation_determined_by_indegrees O₁ O₂ hO₁.1 hO₂.1 intro v - have h_deg₁ := orientation_to_config_indeg G O₁ q hO₁ v have h_deg₂ := orientation_to_config_indeg G O₂ q hO₂ v - - have h_config_eq : (orientation_to_config G O₁ q hO₁).chips v = - (orientation_to_config G O₂ q hO₂).chips v := by + have h_config_eq : (orientationToConfig G O₁ q hO₁).chips v = + (orientationToConfig G O₂ q hO₂).chips v := by rw [h_eq₁, h_eq₂] - by_cases hv : v = q · -- Case v = q: Both vertices are sources, so indegree is 0 rw [hv] @@ -634,11 +630,11 @@ lemma degree_ordiv {G : CFGraph} (O : CFOrientation G) : apply Finset.sum_congr rfl intro x _ rw [indeg_eq_sum_flow] - _ = ∑ v : G.V, Multiset.card (O.directed_edges.filter (λ e => e.snd = v)) := by + _ = ∑ v : G.V, Multiset.card (O.directedEdges.filter (fun e => e.snd = v)) := by dsimp only [indeg] - _ = ↑(Multiset.card O.directed_edges) := by + _ = ↑(Multiset.card O.directedEdges) := by -- Each directed edge points into exactly one vertex - rw [sum_card_filter_eq_mul G O.directed_edges (λ v e => e.snd = v) 1 ?_, one_mul] + rw [sum_card_filter_eq_mul G O.directedEdges (fun v e => e.snd = v) 1 ?_, one_mul] intro e _ refine Finset.card_eq_one.mpr ⟨e.2, ?_⟩ ext x @@ -650,10 +646,10 @@ lemma degree_ordiv {G : CFGraph} (O : CFOrientation G) : /-- The configuration degree of an acyclic orientation with unique source equals the genus. -/ lemma config_degree_from_O {G : CFGraph} (O : CFOrientation G) {q : G.V} - (hO : acyclic_with_unique_source G O q) : - config_degree (orientation_to_config G O q hO) = genus G := by + (hO : acyclicWithUniqueSource G O q) : + configDegree (orientationToConfig G O q hO) = genus G := by rw [config_and_divisor_from_O O hO] - -- Use config_degree_div_degree to relate config_degree to deg of the underlying divisor. + -- Use config_degree_div_degree to relate configDegree to deg of the underlying divisor. have h_q_source : indeg G O q = 0 := source_of_acyclic_with_unique_source hO have h1 := config_degree_div_degree (orqed O hO) -- (orqed O ...).D = ordiv G O definitionally, so: @@ -667,31 +663,28 @@ winnable. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Proposition 4.11. -/ lemma ordiv_unwinnable (G : CFGraph) (O : CFOrientation G) : - is_acyclic G O → ¬ winnable G (ordiv G O) := by + isAcyclic G O → ¬ winnable G (ordiv G O) := by intro h_acyclic by_contra h_win let D := ordiv G O rcases h_win with ⟨E, E_eff, E_equiv⟩ dsimp only [Eff] at E_eff - dsimp only [linear_equiv] at E_equiv + dsimp only [linearEquiv] at E_equiv rw [principal_iff_eq_prin] at E_equiv rcases E_equiv with ⟨σ, h_σ⟩ apply eq_add_of_sub_eq at h_σ - obtain ⟨v_max, -, h_max⟩ := Finset.exists_max_image Finset.univ σ Finset.univ_nonempty have h_max : ∀ w : G.V, σ w ≤ σ v_max := fun w => h_max w (Finset.mem_univ w) let S := {v : G.V | σ v = σ v_max} have S_nonempty : S.Nonempty := by use v_max simp only [Set.mem_ofPred_eq, S] - have h_lt (u : G.V) (h_u : u ∉ S): σ u ≤ σ v_max - 1 := by specialize h_max u suffices σ u < σ v_max by linarith apply lt_of_le_of_ne h_max simp only [Set.mem_ofPred_eq, S] at h_u exact h_u - suffices h_v : ∃ v ∈ S, ∀ w : G.V, flow O w v > 0 → w ∉ S by rcases h_v with ⟨v, h_v, h_flow⟩ have h_prin : (prin G) σ v + indeg G O v ≤ 0 := by @@ -710,7 +703,8 @@ lemma ordiv_unwinnable (G : CFGraph) (O : CFOrientation G) : have := h_lt u h_u_in_S rw [h_v] linarith [this] - have h_diff_mul : ∀ u : G.V, (σ u - σ v) * ↑(num_edges G v u) ≤ if u ∈ S then 0 else -↑(num_edges G v u) := by + have h_diff_mul : ∀ u : G.V, (σ u - σ v) * ↑(numEdges G v u) ≤ if u ∈ S then 0 else + -↑(numEdges G v u) := by intro u by_cases h_u_in_S : u ∈ S · simp only [h_u_in_S, ↓reduceIte] @@ -723,22 +717,20 @@ lemma ordiv_unwinnable (G : CFGraph) (O : CFOrientation G) : apply le_of_sub_nonneg rw [neg_eq_neg_one_mul, ← sub_mul] apply mul_nonneg - linarith + · linarith exact Nat.cast_nonneg _ - have h_sum : ∑ w : G.V, (σ w - σ v) * ↑(num_edges G v w) ≤ ∑ w : G.V, if w ∈ S then 0 else -↑(num_edges G v w) := by + have h_sum : ∑ w : G.V, (σ w - σ v) * ↑(numEdges G v w) ≤ ∑ w : G.V, if w ∈ S then 0 else + -↑(numEdges G v w) := by apply Finset.sum_le_sum intro u _ specialize h_diff_mul u - exact h_diff_mul - suffices ∑ u : G.V, ((σ u - σ v) * ↑(num_edges G v u)) ≤ -↑ (∑ u: G.V, (flow O u v)) by linarith + suffices ∑ u : G.V, ((σ u - σ v) * ↑(numEdges G v u)) ≤ -↑ (∑ u: G.V, (flow O u v)) by + linarith refine le_trans h_sum ?_ apply le_of_neg_le_neg rw [neg_neg, Nat.cast_sum, neg_eq_neg_one_mul, mul_comm (-1), Finset.sum_mul] - - apply sum_le_sum - intro u _ by_cases h_u_in_S : u ∈ S · -- Case: u ∈ S. No edges from u to v. @@ -750,7 +742,7 @@ lemma ordiv_unwinnable (G : CFGraph) (O : CFOrientation G) : exact ⟨h_flow, h_u_in_S⟩ · -- Case : u ∉ S. simp only [h_u_in_S, ↓reduceIte, Int.reduceNeg, mul_neg, mul_one, neg_neg, Nat.cast_le] - -- Goal: flow O u v ≤ num_edges G v u + -- Goal: flow O u v ≤ numEdges G v u rw [← opp_flow O v u] linarith specialize E_eff v @@ -759,7 +751,7 @@ lemma ordiv_unwinnable (G : CFGraph) (O : CFOrientation G) : dsimp only [ordiv] at E_eff linarith -- Now we must find a source of O relative to S - let S' := Finset.filter (λ v => v ∈ S) Finset.univ + let S' := Finset.filter (fun v => v ∈ S) Finset.univ have S'_nonempty : S'.Nonempty := by rcases S_nonempty with ⟨v, h_v_in_S⟩ use v @@ -787,7 +779,7 @@ See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Proposition 4.11, w asserts that $D(\mathcal{O})$ is maximal unwinnable; this lemma and `ordiv_unwinnable` supply the unwinnability, while maximality is established in `RRGHelpers.lean`. -/ private lemma ordiv_q_reduced {G : CFGraph} (O : CFOrientation G) {q : G.V} - (hO : acyclic_with_unique_source G O q) : q_reduced G q (ordiv G O) := by + (hO : acyclicWithUniqueSource G O q) : qReduced G q (ordiv G O) := by constructor · -- Show ordiv is effective away from q intro v h_v_ne_q @@ -798,7 +790,7 @@ private lemma ordiv_q_reduced {G : CFGraph} (O : CFOrientation G) {q : G.V} contrapose! h_v_ne_q with indeg_zero apply hO.2 apply Nat.eq_zero_of_le_zero at indeg_zero - dsimp only [is_source] + dsimp only [isSource] simp only [indeg_zero] · -- Show no valid firing move exists for subsets not containing q intro S h_q_S S_nonempty hlegal @@ -812,20 +804,21 @@ private lemma ordiv_q_reduced {G : CFGraph} (O : CFOrientation G) {q : G.V} -- Expand indeg and compare terms rw [indeg_eq_sum_flow O v, Nat.cast_sum] -- Split the LHS sum into the x ∈ S part and the x ∉ S part - have flow_bound (w : G.V) : flow O w v ≤ if w ∈ S then 0 else num_edges G w v := by + have flow_bound (w : G.V) : flow O w v ≤ if w ∈ S then 0 else numEdges G w v := by by_cases h_w_in_S : w ∈ S · -- Case: w ∈ S simp only [h_w_in_S, ↓reduceIte, nonpos_iff_eq_zero, count_eq_zero] specialize h_flow w apply h_flow at h_w_in_S dsimp only [flow] at h_w_in_S - -- Now deduce (w,v) ∉ O.directed_edges from count = 0. + -- Now deduce (w,v) ∉ O.directedEdges from count = 0. exact Multiset.count_eq_zero.mp h_w_in_S · -- Case: w ∉ S simp only [h_w_in_S, ↓reduceIte] rw [← opp_flow O w v] linarith - have sum_flow_bound : ∑ w : G.V, ↑(flow O w v) ≤ ∑ w : G.V, if w ∈ S then 0 else ↑(num_edges G w v) := by + have sum_flow_bound : ∑ w : G.V, ↑(flow O w v) ≤ ∑ w : G.V, if w ∈ S then 0 else ↑(numEdges + G w v) := by apply Finset.sum_le_sum intro u _ specialize flow_bound u @@ -836,17 +829,16 @@ private lemma ordiv_q_reduced {G : CFGraph} (O : CFOrientation G) {q : G.V} rw [← Nat.cast_sum, ← Nat.cast_sum] apply Nat.cast_le.mpr apply le_trans sum_flow_bound - -- Final step: we have num_edges G _ v on LHS and G v _ on the right. Use symmetry. + -- Final step: we have numEdges G _ v on LHS and G v _ on the right. Use symmetry. simp only [num_edges_symmetric, Std.le_refl] /-- The configuration associated to an acyclic orientation with unique source $q$ is superstable. -/ private lemma orientation_config_superstable (G : CFGraph) (O : CFOrientation G) (q : G.V) - (hO : acyclic_with_unique_source G O q) : - superstable G q (orientation_to_config G O q hO) := by - let c := orientation_to_config G O q hO + (hO : acyclicWithUniqueSource G O q) : + superstable G q (orientationToConfig G O q hO) := by + let c := orientationToConfig G O q hO apply (superstable_iff_q_reduced G q (genus G -1) c).mpr - have h_c := config_and_divisor_from_O O hO dsimp only [c] rw [h_c] @@ -877,8 +869,8 @@ See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 5.7. It is independent of orientation and equals $D(\mathcal{O}) + D(\overline{\mathcal{O}})$. -/ -def canonical_divisor (G : CFGraph) : CFDiv G := - λ v => (vertex_degree G v) - 2 +def canonicalDivisor (G : CFGraph) : CFDiv G := + fun v => (vertexDegree G v) - 2 /-- Counting a pair in a multiset mapped by `Prod.swap` counts the swapped pair in the original multiset. Specialization of `Multiset.count_map_eq_count'` to `Prod.swap`. -/ @@ -890,7 +882,7 @@ private lemma count_map_swap {G : CFGraph} (M : Multiset (G.V × G.V)) (v w : G. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 5.7. -/ def CFOrientation.reverse (G : CFGraph) (O : CFOrientation G) : CFOrientation G where - directed_edges := O.directed_edges.map Prod.swap + directedEdges := O.directedEdges.map Prod.swap count_preserving v w := by rw [count_map_swap, count_map_swap, add_comm] exact O.count_preserving v w @@ -899,7 +891,7 @@ def CFOrientation.reverse (G : CFGraph) (O : CFOrientation G) : CFOrientation G flow of $\mathcal{O}$ from $w$ to $v$. -/ private lemma flow_reverse {G : CFGraph} (O : CFOrientation G) (v w : G.V) : flow (O.reverse G) v w = flow O w v := - count_map_swap O.directed_edges v w + count_map_swap O.directedEdges v w /-- The in-degree of $v$ in the reverse orientation $\overline{\mathcal{O}}$ equals the out-degree of $v$ in $\mathcal{O}$. -/ @@ -908,7 +900,8 @@ private lemma indeg_reverse_eq_outdeg (G : CFGraph) (O : CFOrientation G) (v : G classical simp only [indeg, outdeg] rw [← Multiset.countP_eq_card_filter, ← Multiset.countP_eq_card_filter] - let O_rev_edges_def : (CFOrientation.reverse G O).directed_edges = O.directed_edges.map Prod.swap := by rfl + let O_rev_edges_def : (CFOrientation.reverse G O).directedEdges = O.directedEdges.map + Prod.swap := by rfl conv_lhs => rw [O_rev_edges_def] rw [Multiset.countP_map] simp only [Prod.snd_swap] @@ -916,8 +909,8 @@ private lemma indeg_reverse_eq_outdeg (G : CFGraph) (O : CFOrientation G) (v : G /-- The reverse of an acyclic orientation is also acyclic. -/ lemma is_acyclic_reverse_of_is_acyclic (G : CFGraph) (O : CFOrientation G) - (h_acyclic : is_acyclic G O) : - is_acyclic G (O.reverse G) := by + (h_acyclic : isAcyclic G O) : + isAcyclic G (O.reverse G) := by intro p let q : DirectedPath O := { vertices := p.vertices.reverse, @@ -927,32 +920,33 @@ lemma is_acyclic_reverse_of_is_acyclic (G : CFGraph) (O : CFOrientation G) valid_edges := by have p_valid := p.valid_edges have hyp := List.isChain_reverse.mpr p_valid - -- hyp : List.IsChain (flip (directed_edge G (CFOrientation.reverse G O))) p.vertices - -- Need to show: List.IsChain (directed_edge G (CFOrientation.reverse G O)) p.vertices.reverse + -- hyp : List.IsChain (flip (directedEdge G (CFOrientation.reverse G O))) p.vertices + -- Need to show: List.IsChain (directedEdge G (CFOrientation.reverse G O)) p.vertices.reverse -- Since isChain_reverse gives us the flipped relation, we need to show - -- flip (directed_edge G (CFOrientation.reverse G O)) = directed_edge G O + -- flip (directedEdge G (CFOrientation.reverse G O)) = directedEdge G O convert hyp using 2 ext a - simp only [directed_edge, CFOrientation.reverse, Multiset.mem_map, Prod.exists, + simp only [directedEdge, CFOrientation.reverse, Multiset.mem_map, Prod.exists, Prod.swap_prod_mk, Prod.mk.injEq, ↓existsAndEq, true_and, exists_eq_right] } - have h_non_repeating_q : non_repeating q := h_acyclic q + have h_non_repeating_q : nonRepeating q := h_acyclic q exact List.nodup_reverse.mp h_non_repeating_q /-- The orientation divisors of $\mathcal{O}$ and its reverse sum to the canonical divisor: $D(\mathcal{O}) + D(\overline{\mathcal{O}}) = K_G$. -/ -lemma divisor_reverse_orientation {G : CFGraph} (O : CFOrientation G) : ordiv G O + ordiv G (O.reverse) = canonical_divisor G := by +lemma divisor_reverse_orientation {G : CFGraph} (O : CFOrientation G) : ordiv G O + ordiv G + (O.reverse) = canonicalDivisor G := by let O' := O.reverse funext v rw [Pi.add_apply] - dsimp only [ordiv, canonical_divisor] - suffices indeg G O v + indeg G O' v = vertex_degree G v by - dsimp only [vertex_degree] at this ⊢ + dsimp only [ordiv, canonicalDivisor] + suffices indeg G O v + indeg G O' v = vertexDegree G v by + dsimp only [vertexDegree] at this ⊢ rw [← this] ring rw [indeg_eq_sum_flow, indeg_eq_sum_flow, Nat.cast_sum, Nat.cast_sum] - dsimp only [vertex_degree] + dsimp only [vertexDegree] rw [← sum_add_distrib] apply Finset.sum_congr rfl intro w _ @@ -966,112 +960,116 @@ lemma divisor_reverse_orientation {G : CFGraph} (O : CFOrientation G) : ordiv G See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Exercise 5.8. -/ theorem degree_of_canonical_divisor (G : CFGraph) : - deg (canonical_divisor G) = 2 * genus G - 2 := by + deg (canonicalDivisor G) = 2 * genus G - 2 := by -- Use sum_sub_distrib to split the sum - have h1 : ∑ v, (canonical_divisor G v) = - ∑ v, vertex_degree G v - 2 * Fintype.card G.V := by - unfold canonical_divisor + have h1 : ∑ v, (canonicalDivisor G v) = + ∑ v, vertexDegree G v - 2 * Fintype.card G.V := by + unfold canonicalDivisor rw [sum_sub_distrib] simp only [sum_const, card_univ, Int.nsmul_eq_mul, sub_right_inj] ring dsimp only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk] rw [h1] - -- Use the fact that sum of vertex degrees = 2|E| - have h2 : ∑ v, vertex_degree G v = 2 * Multiset.card G.edges := by + have h2 : ∑ v, vertexDegree G v = 2 * Multiset.card G.edges := by exact sum_vertex_degree_eq_twice_card_edges G rw [h2] - -- Use genus definition: g = |E| - |G.V| + 1 rw [genus] - ring /-! ## Orientations from burn lists Given a complete burn list $L$ for a superstable configuration $c$, the function -`burn_orientation L h_full` constructs an acyclic orientation of $G$ with unique source $q$ +`burnOrientation L h_full` constructs an acyclic orientation of $G$ with unique source $q$ (`burn_acyclic`, `burn_unique_source`). Acyclicity is proved by showing that position in the burn list gives a strictly decreasing labeling along any directed path (`dp_dec`). The key lemma `dp_dec` formalizes this as a strict chain of natural numbers, and -`orientation_from_flow` constructs a `CFOrientation` from an explicit flow function. +`orientationFromFlow` constructs a `CFOrientation` from an explicit flow function. -/ /-- Create a multiset with a given count function. This is a thin wrapper around `DFinsupp.toMultiset` specialized to a finite type. -/ -def multiset_of_count {T : Type*} [DecidableEq T] [Fintype T] (f : T → ℕ) : Multiset T := +def multisetOfCount {T : Type*} [DecidableEq T] [Fintype T] (f : T → ℕ) : Multiset T := DFinsupp.toMultiset (DFinsupp.equivFunOnFintype.symm f) @[simp] private lemma count_of_multiset_of_count {T : Type*} [DecidableEq T] [Fintype T] - (f : T → ℕ) : ∀ e : T, Multiset.count e (multiset_of_count f) = f e := by + (f : T → ℕ) : ∀ e : T, Multiset.count e (multisetOfCount f) = f e := by intro e rw [← Multiset.toDFinsupp_apply] calc - (Multiset.toDFinsupp (multiset_of_count f)) e = (DFinsupp.equivFunOnFintype.symm f) e := by - simp only [multiset_of_count, DFinsupp.toMultiset_toDFinsupp] + (Multiset.toDFinsupp (multisetOfCount f)) e = (DFinsupp.equivFunOnFintype.symm f) e := by + simp only [multisetOfCount, DFinsupp.toMultiset_toDFinsupp] _ = f e := by simpa only [DFinsupp.equivFunOnFintype_apply] using congrFun (Equiv.apply_symm_apply DFinsupp.equivFunOnFintype f) e /-- Constructs a `CFOrientation` from an explicit flow function, given proofs that it respects edge multiplicities and has no bidirectional edges. -/ -def orientation_from_flow {G : CFGraph} (f : G.V × G.V → ℕ) (h_count_preserving : ∀ v w : G.V, f (v,w) + f (w,v) = num_edges G v w) : CFOrientation G := +def orientationFromFlow {G : CFGraph} (f : G.V × G.V → ℕ) (h_count_preserving : ∀ v w : G.V, f + (v,w) + f (w,v) = numEdges G v w) : CFOrientation G := { - directed_edges := multiset_of_count f, + directedEdges := multisetOfCount f, count_preserving := by intro v w simpa only [count_of_multiset_of_count] using (h_count_preserving v w).symm } /-- The orientation constructed from a complete burn list $L$ for a superstable configuration, -via `burn_flow`. This is shown to be acyclic with unique source $q$ by `burn_acyclic` and +via `burnFlow`. This is shown to be acyclic with unique source $q$ by `burn_acyclic` and `burn_unique_source`. -/ -def burn_orientation {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (h_full : ∀ (v :G.V), v ∈ L.list): CFOrientation G := orientation_from_flow (burn_flow L) (burn_flow_reverse L h_full) +def burnOrientation {G : CFGraph} {q : G.V} {c : Config G q} (L : burnList G c) (h_full : ∀ (v + : G.V), v ∈ L.list) : CFOrientation G := orientationFromFlow (burnFlow L) (burn_flow_reverse L + h_full) -/-- Along any directed path in `burn_orientation L`, the positions of vertices in the burn list +/-- Along any directed path in `burnOrientation L`, the positions of vertices in the burn list are strictly decreasing. This is the key lemma for proving acyclicity. -/ -private lemma dp_dec {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (h_full : ∀ (v :G.V), v ∈ L.list) (p : DirectedPath (burn_orientation L h_full)) : - List.IsChain (· > ·) (p.vertices.map (λ v => List.idxOf v L.list)) := by +private lemma dp_dec {G : CFGraph} {q : G.V} {c : Config G q} (L : burnList G c) (h_full : ∀ (v + : G.V), v ∈ L.list) (p : DirectedPath (burnOrientation L h_full)) : + List.IsChain (· > ·) (p.vertices.map (fun v => List.idxOf v L.list)) := by refine List.isChain_map_of_isChain (f := fun v => List.idxOf v L.list) ?_ p.valid_edges intro v v' h_edge - dsimp only [directed_edge] at h_edge - simp only [burn_orientation] at h_edge - dsimp only [orientation_from_flow] at h_edge - have h_count : Multiset.count ⟨v,v'⟩ (multiset_of_count (burn_flow L)) > 0 := by + dsimp only [directedEdge] at h_edge + simp only [burnOrientation] at h_edge + dsimp only [orientationFromFlow] at h_edge + have h_count : Multiset.count ⟨v,v'⟩ (multisetOfCount (burnFlow L)) > 0 := by contrapose! h_edge with h_zero apply Nat.eq_zero_of_le_zero at h_zero exact Multiset.count_eq_zero.mp h_zero simp only [count_of_multiset_of_count, gt_iff_lt] at h_count - dsimp only [burn_flow] at h_count + dsimp only [burnFlow] at h_count by_contra! h_not_gt have : ¬ (v ∈ L.list ∧ List.idxOf v' L.list < List.idxOf v L.list) := by intro ⟨_, h_lt⟩ omega simp only [this, ↓reduceIte, lt_self_iff_false] at h_count -/-- Every directed path in `burn_orientation L` has no repeated vertices. -/ -private lemma burn_nodup {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (h_full : ∀ (v :G.V), v ∈ L.list) (p : DirectedPath (burn_orientation L h_full)) : p.vertices.Nodup := by - let q : List ℕ := p.vertices.map (λ v => List.idxOf v L.list) +/-- Every directed path in `burnOrientation L` has no repeated vertices. -/ +private lemma burn_nodup {G : CFGraph} {q : G.V} {c : Config G q} (L : burnList G c) (h_full : ∀ + (v : G.V), v ∈ L.list) (p : DirectedPath (burnOrientation L h_full)) : p.vertices.Nodup := by + let q : List ℕ := p.vertices.map (fun v => List.idxOf v L.list) have h_sorted : q.SortedGT := (List.sortedGT_iff_isChain).2 (dp_dec L h_full p) - exact List.Nodup.of_map (λ v => List.idxOf v L.list) h_sorted.nodup + exact List.Nodup.of_map (fun v => List.idxOf v L.list) h_sorted.nodup /-- The orientation constructed from a complete burn list is acyclic. -/ -private lemma burn_acyclic {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (h_full : ∀ (v :G.V), v ∈ L.list) : - is_acyclic G (burn_orientation L h_full) := by - dsimp only [is_acyclic] +private lemma burn_acyclic {G : CFGraph} {q : G.V} {c : Config G q} (L : burnList G c) (h_full : + ∀ (v : G.V), v ∈ L.list) : + isAcyclic G (burnOrientation L h_full) := by + dsimp only [isAcyclic] intro p - dsimp only [non_repeating] + dsimp only [nonRepeating] exact burn_nodup L h_full p /-- The orientation constructed from a complete burn list has $q$ as its unique source. -/ -private lemma burn_unique_source {G : CFGraph} {q : G.V} {c : Config G q} (L : burn_list G c) (h_full : ∀ (v :G.V), v ∈ L.list) : - ∀ w, is_source G (burn_orientation L h_full) w → w = q := by +private lemma burn_unique_source {G : CFGraph} {q : G.V} {c : Config G q} (L : burnList G c) + (h_full : ∀ (v : G.V), v ∈ L.list) : + ∀ w, isSource G (burnOrientation L h_full) w → w = q := by intro w h_source - dsimp only [is_source] at h_source - rw [indeg_eq_sum_flow (burn_orientation L h_full) w] at h_source - dsimp only [burn_orientation, orientation_from_flow, flow] at h_source + dsimp only [isSource] at h_source + rw [indeg_eq_sum_flow (burnOrientation L h_full) w] at h_source + dsimp only [burnOrientation, orientationFromFlow, flow] at h_source simp only [count_of_multiset_of_count] at h_source -- Remove the decide and true parts contrapose! h_source with h_ne @@ -1088,8 +1086,8 @@ private lemma burn_unique_source {G : CFGraph} {q : G.V} {c : Config G q} (L : b /-- The orientation constructed from a complete burn list is acyclic with unique source $q$. -/ private lemma burn_acyclic_with_unique_source {G : CFGraph} {q : G.V} {c : Config G q} - (L : burn_list G c) (h_full : ∀ (v : G.V), v ∈ L.list) : - acyclic_with_unique_source G (burn_orientation L h_full) q := + (L : burnList G c) (h_full : ∀ (v : G.V), v ∈ L.list) : + acyclicWithUniqueSource G (burnOrientation L h_full) q := ⟨burn_acyclic L h_full, burn_unique_source L h_full⟩ @@ -1114,14 +1112,14 @@ See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 4.8. /-- Dhar's burning algorithm produces, from a superstable configuration, an orientation whose associated configuration dominates it. -/ theorem superstable_dhar {G : CFGraph} {q : G.V} {c : Config G q} (h_ss : superstable G q c) : - ∃ (O : CFOrientation G) (hO : acyclic_with_unique_source G O q), - c ≤ orientation_to_config G O q hO := by + ∃ (O : CFOrientation G) (hO : acyclicWithUniqueSource G O q), + c ≤ orientationToConfig G O q hO := by rcases superstable_burn_list G c h_ss with ⟨L, h_full⟩ - let O := burn_orientation L h_full - have hO : acyclic_with_unique_source G O q := burn_acyclic_with_unique_source L h_full + let O := burnOrientation L h_full + have hO : acyclicWithUniqueSource G O q := burn_acyclic_with_unique_source L h_full use O, hO intro v - dsimp only [orientation_to_config, config_of_source] + dsimp only [orientationToConfig, configOfSource] by_cases h_vq : v = q · -- Case: v = q rw [h_vq] @@ -1131,7 +1129,7 @@ theorem superstable_dhar {G : CFGraph} {q : G.V} {c : Config G q} (h_ss : supers simp only [h_vq, ↓reduceIte] rw [indeg_eq_sum_flow O v] dsimp only [flow] - dsimp only [burn_orientation, orientation_from_flow, O] + dsimp only [burnOrientation, orientationFromFlow, O] simp only [count_of_multiset_of_count] have ineq := burnin_degree L v (h_full v) h_vq linarith @@ -1142,25 +1140,25 @@ superstable. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 4.8, part 1 ($c(\mathcal{O})$ is maximal superstable). -/ theorem orientation_config_maximal (G : CFGraph) (O : CFOrientation G) (q : G.V) - (hO : acyclic_with_unique_source G O q) : - maximal_superstable G (orientation_to_config G O q hO) := by - dsimp only [maximal_superstable] - let cO := orientation_to_config G O q hO + (hO : acyclicWithUniqueSource G O q) : + maximalSuperstable G (orientationToConfig G O q hO) := by + dsimp only [maximalSuperstable] + let cO := orientationToConfig G O q hO have h_ssO : superstable G q cO := orientation_config_superstable G O q hO refine ⟨h_ssO, ?_⟩ -- Goal is now just maximality of cO. -- Suppose another divisor is bigger. There's an orientation divisor yet above that one. intro c h_ss h_ge rcases superstable_dhar h_ss with ⟨O', hO', h_ge'⟩ - let c' := orientation_to_config G O' q hO' + let c' := orientationToConfig G O' q hO' -- Sandwich c between cO and c', which have the same degree - have h_deg_le : config_degree cO ≤ config_degree c := config_degree_mono h_ge - have h_deg_le' : config_degree c ≤ config_degree c' := config_degree_mono h_ge' + have h_deg_le : configDegree cO ≤ configDegree c := config_degree_mono h_ge + have h_deg_le' : configDegree c ≤ configDegree c' := config_degree_mono h_ge' rw [config_degree_from_O O hO] at h_deg_le rw [config_degree_from_O O' hO'] at h_deg_le' - have h_deg : config_degree c = genus G := by + have h_deg : configDegree c = genus G := by linarith - have h_deg : config_degree c = config_degree cO := by + have h_deg : configDegree c = configDegree cO := by rw [config_degree_from_O O hO] exact h_deg -- Now apply config equality from degree and ge @@ -1169,9 +1167,9 @@ theorem orientation_config_maximal (G : CFGraph) (O : CFOrientation G) (q : G.V) /-- Every superstable configuration extends to a maximal superstable configuration. -/ theorem maximal_superstable_exists (G : CFGraph) (q : G.V) (c : Config G q) (h_super : superstable G q c) : - ∃ c' : Config G q, maximal_superstable G c' ∧ c ≤ c' := by + ∃ c' : Config G q, maximalSuperstable G c' ∧ c ≤ c' := by rcases superstable_dhar h_super with ⟨O, hO, h_ge⟩ - let c' := orientation_to_config G O q hO + let c' := orientationToConfig G O q hO use c' refine ⟨?_, h_ge⟩ -- Remains to show c' is maximal superstable @@ -1182,12 +1180,12 @@ theorem maximal_superstable_exists (G : CFGraph) (q : G.V) (c : Config G q) See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 4.8, part 2 (surjectivity). -/ theorem maximal_superstable_orientation (G : CFGraph) (q : G.V) (c : Config G q) - (h_max : maximal_superstable G c) : - ∃ (O : CFOrientation G) (hO : acyclic_with_unique_source G O q), - orientation_to_config G O q hO = c := by + (h_max : maximalSuperstable G c) : + ∃ (O : CFOrientation G) (hO : acyclicWithUniqueSource G O q), + orientationToConfig G O q hO = c := by rcases superstable_dhar h_max.1 with ⟨O, hO, h_ge⟩ use O, hO - let c' := orientation_to_config G O q hO + let c' := orientationToConfig G O q hO have h_eq := h_max.2 c' (orientation_config_superstable G O q hO) h_ge exact h_eq @@ -1197,40 +1195,37 @@ superstable configurations. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 4.8, part 3 (bijection). -/ theorem orientation_superstable_bijection (G : CFGraph) (q : G.V) : - let α := {O : CFOrientation G // acyclic_with_unique_source G O q}; - let β := {c : Config G q // maximal_superstable G c}; - let f_raw : α → Config G q := λ O_sub => orientation_to_config G O_sub.val q O_sub.prop; - let f : α → β := λ O_sub => ⟨f_raw O_sub, orientation_config_maximal G O_sub.val q O_sub.prop⟩; + let α := {O : CFOrientation G // acyclicWithUniqueSource G O q}; + let β := {c : Config G q // maximalSuperstable G c}; + let f_raw : α → Config G q := fun O_sub => orientationToConfig G O_sub.val q O_sub.prop; + let f : α → β := fun O_sub => ⟨f_raw O_sub, orientation_config_maximal G O_sub.val q + O_sub.prop⟩; Function.Bijective f := by -- Define the domain and codomain types explicitly (can be removed if using let like above) - let α := {O : CFOrientation G // acyclic_with_unique_source G O q} - let β := {c : Config G q // maximal_superstable G c} + let α := {O : CFOrientation G // acyclicWithUniqueSource G O q} + let β := {c : Config G q // maximalSuperstable G c} -- Define the function f_raw : α → Config G q - let f_raw : α → Config G q := λ O_sub => orientation_to_config G O_sub.val q O_sub.prop + let f_raw : α → Config G q := fun O_sub => orientationToConfig G O_sub.val q O_sub.prop -- Define the function f : α → β, showing the result is maximal superstable - let f : α → β := λ O_sub => + let f : α → β := fun O_sub => ⟨f_raw O_sub, orientation_config_maximal G O_sub.val q O_sub.prop⟩ - constructor -- Injectivity { -- Prove injective f using injective f_raw intros O₁_sub O₂_sub h_f_eq -- h_f_eq : f O₁_sub = f O₂_sub have h_f_raw_eq : f_raw O₁_sub = f_raw O₂_sub := by simp only [Subtype.mk.injEq] at h_f_eq; exact h_f_eq - -- Reuse original injectivity proof structure, ensuring types match let ⟨O₁, h₁⟩ := O₁_sub let ⟨O₂, h₂⟩ := O₂_sub - -- Define c, h_eq₁, h_eq₂ based on orientation_to_config directly - let c := orientation_to_config G O₁ q h₁ - have h_eq₁ : orientation_to_config G O₁ q h₁ = c := rfl - have h_eq₂ : orientation_to_config G O₂ q h₂ = c := by + -- Define c, h_eq₁, h_eq₂ based on orientationToConfig directly + let c := orientationToConfig G O₁ q h₁ + have h_eq₁ : orientationToConfig G O₁ q h₁ = c := rfl + have h_eq₂ : orientationToConfig G O₂ q h₂ = c := by exact h_f_raw_eq.symm.trans h_eq₁ - apply Subtype.ext exact config_to_orientation_unique G q c O₁ O₂ h₁ h₂ h_eq₁ h_eq₂ } - -- Surjectivity { -- Prove Function.Surjective f unfold Function.Surjective @@ -1238,17 +1233,13 @@ theorem orientation_superstable_bijection (G : CFGraph) (q : G.V) : -- Access components using .val and .property let c_target : Config G q := y.val -- Explicitly type c_target let h_target_max_superstable := y.property - -- Use the fact that every maximal superstable config comes from an orientation. rcases maximal_superstable_orientation G q c_target h_target_max_superstable with ⟨O, hO, h_config_eq_target⟩ - -- Construct the required subtype element x : α (the pre-image) let x : α := ⟨O, hO⟩ - -- Show that this x exists use x - -- Show f x = y using Subtype.eq apply Subtype.ext -- Goal: (f x).val = y.val diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean b/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean index d76971eee4..c0ff50e2ec 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean @@ -5,32 +5,38 @@ Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch +/-! +# PalomarSolution + +Chip firing, graph divisors, and their combinatorial properties. +-/ + namespace Propositions private lemma rank_eq_rank (G : CFGraph) (D : CFDiv G) (r : ℤ) - (h : rank_eq G D r) : rank G D = r := by - change rank_geq G D r ∧ ¬rank_geq G D (r + 1) at h + (h : rankEq G D r) : rank G D = r := by + change rankGeq G D r ∧ ¬rankGeq G D (r + 1) at h rw [rank_geq_iff, rank_geq_iff] at h omega -theorem riemann_roch {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : - ∀ r rdual : ℤ, rank_eq G D r → rank_eq G (canonical_divisor G - D) rdual → +theorem riemann_roch {G : CFGraph} (h_conn : graphConnected G) (D : CFDiv G) : + ∀ r rdual : ℤ, rankEq G D r → rankEq G (canonicalDivisor G - D) rdual → r - rdual = deg D + 1 - genus G := by intro r rdual h_rank h_rankdual have hr : rank G D = r := rank_eq_rank G D r h_rank - have hrdual : rank G (canonical_divisor G - D) = rdual := - rank_eq_rank G (canonical_divisor G - D) rdual h_rankdual + have hrdual : rank G (canonicalDivisor G - D) = rdual := + rank_eq_rank G (canonicalDivisor G - D) rdual h_rankdual have h_rr := riemann_roch_for_graphs h_conn D rw [hr, hrdual] at h_rr linarith -theorem clifford {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : - ∀ r rdual : ℤ, rank_eq G D r → rank_eq G (canonical_divisor G - D) rdual → +theorem clifford {G : CFGraph} (h_conn : graphConnected G) (D : CFDiv G) : + ∀ r rdual : ℤ, rankEq G D r → rankEq G (canonicalDivisor G - D) rdual → 0 ≤ r → 0 ≤ rdual → (r : ℚ) ≤ (deg D : ℚ) / 2 := by intro r rdual h_rank h_rankdual hr_nonneg hrdual_nonneg have hr : rank G D = r := rank_eq_rank G D r h_rank - have hrdual : rank G (canonical_divisor G - D) = rdual := - rank_eq_rank G (canonical_divisor G - D) rdual h_rankdual + have hrdual : rank G (canonicalDivisor G - D) = rdual := + rank_eq_rank G (canonicalDivisor G - D) rdual h_rankdual have h_clifford := clifford_theorem h_conn D (by simpa [hr] using hr_nonneg) (by simpa [hrdual] using hrdual_nonneg) rw [hr] at h_clifford diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean b/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean index 190b7e0ca3..9630ecaede 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean @@ -6,9 +6,6 @@ Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger import LeanPool.ChipFiring.ChipFiringWithLean.Orientation import LeanPool.ChipFiring.ChipFiringWithLean.Rank - -open Multiset Finset - /-! ## Maximal superstable configurations and maximal unwinnable divisors @@ -23,26 +20,31 @@ maximal unwinnable divisors: - Every maximal unwinnable divisor has degree $g - 1$ (`maximal_unwinnable_deg`). -/ + +open Multiset Finset + + + /-- The chosen unique $q$-reduced representative of the linear equivalence class of $D$. -/ noncomputable def qReducedRep {G : CFGraph} - (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : CFDiv G := + (h_conn : graphConnected G) (q : G.V) (D : CFDiv G) : CFDiv G := Classical.choose (unique_q_reduced h_conn q D) /-- The canonical representative is linearly equivalent to $D$ and is $q$-reduced. -/ private lemma qReducedRep_spec {G : CFGraph} - (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : - linear_equiv G D (qReducedRep h_conn q D) ∧ q_reduced G q (qReducedRep h_conn q D) := + (h_conn : graphConnected G) (q : G.V) (D : CFDiv G) : + linearEquiv G D (qReducedRep h_conn q D) ∧ qReduced G q (qReducedRep h_conn q D) := (Classical.choose_spec (unique_q_reduced h_conn q D)).1 /-- The configuration obtained from the canonical $q$-reduced representative of $D$ by zeroing out the chips at $q$. -/ noncomputable def qReducedConfig {G : CFGraph} - (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : Config G q := + (h_conn : graphConnected G) (q : G.V) (D : CFDiv G) : Config G q := toConfig ⟨qReducedRep h_conn q D, (qReducedRep_spec h_conn q D).2.1⟩ /-- The canonical configuration attached to $D$ is superstable. -/ private lemma qReducedConfig_superstable {G : CFGraph} - (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : + (h_conn : graphConnected G) (q : G.V) (D : CFDiv G) : superstable G q (qReducedConfig h_conn q D) := by exact q_reduced_toConfig_superstable G q (qReducedRep h_conn q D) (qReducedRep_spec h_conn q D).2 @@ -50,47 +52,45 @@ private lemma qReducedConfig_superstable {G : CFGraph} $c$ and integer $k$. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Remark 3.14. -/ -lemma superstable_of_divisor {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : +lemma superstable_of_divisor {G : CFGraph} (h_conn : graphConnected G) (q : G.V) (D : CFDiv G) : ∃ (c : Config G q) (k : ℤ), - linear_equiv G D (c.chips + k • (one_chip q)) ∧ + linearEquiv G D (c.chips + k • (oneChip q)) ∧ superstable G q c := by let D' := qReducedRep h_conn q D let c := qReducedConfig h_conn q D use c, D' q constructor - · - have h := (qReducedRep_spec h_conn q D).1 + · have h := (qReducedRep_spec h_conn q D).1 rw [q_reduced_eq_chips_add_q G q (qReducedRep h_conn q D) (qReducedRep_spec h_conn q D).2] at h exact h - · - simpa only using qReducedConfig_superstable h_conn q D + · simpa only using qReducedConfig_superstable h_conn q D /-- If $D$ is unwinnable and $D \sim c + k \cdot q$ for a superstable $c$, then $k < 0$. -/ lemma superstable_of_divisor_negative_k (G : CFGraph) (q : G.V) (D : CFDiv G) : ¬(winnable G D) → ∀ (c : Config G q) (k : ℤ), - linear_equiv G D (c.chips + k • (one_chip q)) → + linearEquiv G D (c.chips + k • (oneChip q)) → superstable G q c → k < 0 := by intro h_not_winnable c k h_equiv h_super contrapose! h_not_winnable with k_nonneg - let D' := c.chips + k • (one_chip q) + let D' := c.chips + k • (oneChip q) have D'_eff : effective D' := by - rw [show D' = toDiv (config_degree c + k) c by + rw [show D' = toDiv (configDegree c + k) c by dsimp only [D'] rw [toDiv_config_degree_add]] - exact (config_eff (config_degree c + k) c).2 (by linarith) + exact (config_eff (configDegree c + k) c).2 (by linarith) have h_winnable_D' : winnable G D' := winnable_of_effective G D' D'_eff exact winnable_equiv_winnable G D' D h_winnable_D' h_equiv.symm /-- If $D$ is maximal unwinnable and $q$-reduced, then $D(q) = -1$. -/ private lemma maximal_unwinnable_q_reduced_chips_at_q (G : CFGraph) (q : G.V) (D : CFDiv G) : - maximal_unwinnable G D → q_reduced G q D → D q = -1 := by + maximalUnwinnable G D → qReduced G q D → D q = -1 := by intro h_max_unwin h_qred have h_neg : D q < 0 := by contrapose! h_max_unwin - unfold maximal_unwinnable + unfold maximalUnwinnable push Not intro h_unwin absurd h_unwin @@ -101,10 +101,10 @@ private lemma maximal_unwinnable_q_reduced_chips_at_q (G : CFGraph) (q : G.V) (D · rw [hv] exact h_max_unwin · exact h_qred.1 v (by simp only [ne_eq, hv, not_false_eq_true]) - have h_add_win : winnable G (D + one_chip q) := by exact (h_max_unwin.2 q) - have h_eff : effective (D + one_chip q) := by - apply effective_of_winnable_and_q_reduced G q (D + one_chip q) h_add_win - -- Prove q-reducedness of D + one_chip q + have h_add_win : winnable G (D + oneChip q) := by exact (h_max_unwin.2 q) + have h_eff : effective (D + oneChip q) := by + apply effective_of_winnable_and_q_reduced G q (D + oneChip q) h_add_win + -- Prove q-reducedness of D + oneChip q constructor · intro v hv have h_v_ne_q : v ≠ q := by @@ -129,7 +129,8 @@ private lemma maximal_unwinnable_q_reduced_chips_at_q (G : CFGraph) (q : G.V) (D See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 4.9(1), "only if" direction. -/ -private lemma degree_max_superstable {G : CFGraph} {q : G.V} (c : Config G q) (h_max : maximal_superstable G c): config_degree c = genus G := by +private lemma degree_max_superstable {G : CFGraph} {q : G.V} (c : Config G q) (h_max : + maximalSuperstable G c) : configDegree c = genus G := by have := maximal_superstable_orientation G q c h_max rcases this with ⟨O, hO, h_orient_eq⟩ rw [← h_orient_eq] @@ -141,21 +142,22 @@ cited statement. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 4.9(2), "only if" direction. -/ -private lemma maximal_unwinnable_q_reduced_form (G : CFGraph) (q : G.V) (D : CFDiv G) (c : Config G q) : - maximal_unwinnable G D → q_reduced G q D → D = toDiv (deg D) c → D = c.chips - one_chip q := by +private lemma maximal_unwinnable_q_reduced_form (G : CFGraph) (q : G.V) (D : CFDiv G) (c : + Config G q) : + maximalUnwinnable G D → qReduced G q D → D = toDiv (deg D) c → D = c.chips - oneChip q := by intro h_max_unwinnable h_qred h_toDeg have h_c_eq : c = toConfig ⟨D, h_qred.1⟩ := by apply (eq_config_iff_eq_div (deg D) c (toConfig ⟨D, h_qred.1⟩)).mpr exact h_toDeg.symm.trans (q_reduced_toDiv_toConfig G q D h_qred).symm calc - D = (toConfig ⟨D, h_qred.1⟩).chips - one_chip q := by + D = (toConfig ⟨D, h_qred.1⟩).chips - oneChip q := by exact q_reduced_eq_chips_sub_one_chip G q D h_qred (maximal_unwinnable_q_reduced_chips_at_q G q D h_max_unwinnable h_qred) - _ = c.chips - one_chip q := by rw [h_c_eq] + _ = c.chips - oneChip q := by rw [h_c_eq] /-- The degree of a superstable configuration is bounded above by the genus. -/ private lemma superstable_degree_le_genus (G : CFGraph) (q : G.V) (c : Config G q) : - superstable G q c → config_degree c ≤ genus G := by + superstable G q c → configDegree c ≤ genus G := by intro h_super rcases maximal_superstable_exists G q c h_super with ⟨c_max, h_maximal, h_ge_c⟩ rw [← degree_max_superstable c_max h_maximal] @@ -166,12 +168,12 @@ private lemma superstable_degree_le_genus (G : CFGraph) (q : G.V) (c : Config G See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 4.9(1), "if" direction. -/ private lemma maximal_superstable_of_degree_eq_genus (G : CFGraph) (q : G.V) (c : Config G q) : - superstable G q c → config_degree c = genus G → maximal_superstable G c := by + superstable G q c → configDegree c = genus G → maximalSuperstable G c := by intro h_super h_deg_eq -- Choose a maximal above c (we'll show it's equal to c) have := maximal_superstable_exists G q c h_super rcases this with ⟨c_max, h_maximal, h_ge_c⟩ - have c_max_deg : config_degree c_max = genus G := by + have c_max_deg : configDegree c_max = genus G := by exact degree_max_superstable c_max h_maximal let E := c_max.chips - c.chips have E_eff : E ≥ 0 := by @@ -182,7 +184,7 @@ private lemma maximal_superstable_of_degree_eq_genus (G : CFGraph) (q : G.V) (c have E_deg : deg E = 0 := by dsimp only [E] rw [map_sub] - dsimp only [config_degree] at h_deg_eq c_max_deg + dsimp only [configDegree] at h_deg_eq c_max_deg rw [h_deg_eq, c_max_deg] simp only [sub_self] have E_0 : E = 0 := eff_degree_zero E E_eff E_deg @@ -197,44 +199,46 @@ private lemma maximal_superstable_of_degree_eq_genus (G : CFGraph) (q : G.V) (c See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 4.9(1). -/ private theorem maximal_superstable_config_prop (G : CFGraph) (q : G.V) (c : Config G q) : - superstable G q c → (maximal_superstable G c ↔ config_degree c = genus G) := by + superstable G q c → (maximalSuperstable G c ↔ configDegree c = genus G) := by intro h_super constructor - { -- Forward direction: maximal_superstable → degree = g + { -- Forward direction: maximalSuperstable → degree = g intro h_max exact degree_max_superstable c h_max } - { -- Reverse direction: degree = g → maximal_superstable + { -- Reverse direction: degree = g → maximalSuperstable intro h_deg -- Apply the lemma that degree g implies maximality exact maximal_superstable_of_degree_eq_genus G q c h_super h_deg } /-- A divisor of degree at least $g$ is winnable. -/ -lemma winnable_of_deg_ge_genus {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : deg D ≥ genus G → winnable G D := by +lemma winnable_of_deg_ge_genus {G : CFGraph} (h_conn : graphConnected G) (D : CFDiv G) : deg D ≥ + genus G → winnable G D := by intro h_deg_ge_g let q := Classical.arbitrary G.V rcases (exists_q_reduced_representative h_conn q D) with ⟨D_qred, h_equiv, h_qred⟩ rcases (q_reduced_superstable_correspondence G q D_qred).mp h_qred with ⟨c, h_super, h_D_eq⟩ - have h_deg_c : config_degree c ≤ genus G := superstable_degree_le_genus G q c h_super + have h_deg_c : configDegree c ≤ genus G := superstable_degree_le_genus G q c h_super have D_deg : deg D = deg D_qred := linear_equiv_preserves_deg G D D_qred h_equiv refine ⟨D_qred, ?_, h_equiv⟩ -- D_qred = toDiv (deg D_qred) c is effective: there are enough chips at q, since - -- deg D_qred ≥ g ≥ config_degree c + -- deg D_qred ≥ g ≥ configDegree c rw [h_D_eq] exact (config_eff _ c).mpr (by linarith) /-- Adding a chip anywhere to $c'-q$ makes it winnable when $c'$ is maximal superstable. -/ -private lemma maximal_superstable_chip_winnable {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (c' : Config G q) : - maximal_superstable G c' → - ∀ (v : G.V), winnable G (c'.chips- (one_chip q) + (one_chip v)) := by +private lemma maximal_superstable_chip_winnable {G : CFGraph} (h_conn : graphConnected G) (q : + G.V) (c' : Config G q) : + maximalSuperstable G c' → + ∀ (v : G.V), winnable G (c'.chips- (oneChip q) + (oneChip v)) := by intro h_max_superstable v - let D' := c'.chips - one_chip q + one_chip v + let D' := c'.chips - oneChip q + oneChip v have deg_ineq : deg D' ≥ genus G := by calc - deg D' = config_degree c' := by + deg D' = configDegree c' := by dsimp only [D'] - simp only [_root_.map_add, deg_chips_sub_one_chip, config_degree, deg_one_chip, + simp only [_root_.map_add, deg_chips_sub_one_chip, configDegree, deg_one_chip, sub_add_cancel] _ = genus G := degree_max_superstable c' h_max_superstable _ ≥ genus G := by rfl @@ -243,15 +247,15 @@ private lemma maximal_superstable_chip_winnable {G : CFGraph} (h_conn : graph_co /-- A maximal unwinnable $q$-reduced divisor is its canonical configuration minus one chip at $q$. -/ private lemma maximal_unwinnable_q_reduced_toConfig_form {G : CFGraph} (q : G.V) (D : CFDiv G) - (h_max : maximal_unwinnable G D) (h_qred : q_reduced G q D) : - D = (toConfig ⟨D, h_qred.1⟩).chips - one_chip q := by + (h_max : maximalUnwinnable G D) (h_qred : qReduced G q D) : + D = (toConfig ⟨D, h_qred.1⟩).chips - oneChip q := by exact q_reduced_eq_chips_sub_one_chip G q D h_qred (maximal_unwinnable_q_reduced_chips_at_q G q D h_max h_qred) /-- A divisor of the form $c-q$ is maximal unwinnable when $c$ is maximal superstable. -/ private lemma maximal_unwinnable_of_maximal_superstable_form {G : CFGraph} - (h_conn : graph_connected G) (q : G.V) (c : Config G q) : - maximal_superstable G c → maximal_unwinnable G (c.chips - one_chip q) := by + (h_conn : graphConnected G) (q : G.V) (c : Config G q) : + maximalSuperstable G c → maximalUnwinnable G (c.chips - oneChip q) := by intro h_max_c refine ⟨superstable_sub_chip_unwinnable q c h_max_c.1, ?_⟩ intro v @@ -260,16 +264,16 @@ private lemma maximal_unwinnable_of_maximal_superstable_form {G : CFGraph} /-- For a $q$-reduced divisor, maximal unwinnability is equivalent to the maximal superstability of its canonical configuration together with the canonical $c-q$ form. -/ private lemma maximal_unwinnable_q_reduced_toConfig_iff {G : CFGraph} - (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) (h_qred : q_reduced G q D) : - maximal_unwinnable G D ↔ - maximal_superstable G (toConfig ⟨D, h_qred.1⟩) ∧ - D = (toConfig ⟨D, h_qred.1⟩).chips - one_chip q := by + (h_conn : graphConnected G) (q : G.V) (D : CFDiv G) (h_qred : qReduced G q D) : + maximalUnwinnable G D ↔ + maximalSuperstable G (toConfig ⟨D, h_qred.1⟩) ∧ + D = (toConfig ⟨D, h_qred.1⟩).chips - oneChip q := by constructor · intro h_max constructor · let c : Config G q := toConfig ⟨D, h_qred.1⟩ have h_super_c : superstable G q c := q_reduced_toConfig_superstable G q D h_qred - have h_form_D : D = c.chips - one_chip q := by + have h_form_D : D = c.chips - oneChip q := by exact maximal_unwinnable_q_reduced_toConfig_form q D h_max h_qred by_contra h_not_max_c rcases maximal_superstable_exists G q c h_super_c with ⟨c', h_max_c', h_ge⟩ @@ -285,26 +289,26 @@ private lemma maximal_unwinnable_q_reduced_toConfig_iff {G : CFGraph} linarith [h_no v] exact h_ne ((le_antisymm h_ge h_c'_le_c).symm) rcases h_strict with ⟨v, h_v_strict⟩ - have h_H_eff : effective (c'.chips - c.chips - one_chip v) := by + have h_H_eff : effective (c'.chips - c.chips - oneChip v) := by intro w by_cases h_wv : w = v · rw [h_wv] - simp only [Pi.sub_apply, one_chip, ↓reduceIte, Int.sub_nonneg] + simp only [Pi.sub_apply, oneChip, ↓reduceIte, Int.sub_nonneg] linarith [h_ge v, h_v_strict] - · simp only [Pi.sub_apply, one_chip, h_wv, ↓reduceIte, sub_zero, Int.sub_nonneg] + · simp only [Pi.sub_apply, oneChip, h_wv, ↓reduceIte, sub_zero, Int.sub_nonneg] linarith [h_ge w] have h_D''_eq : - c'.chips - one_chip q = - (c'.chips - c.chips - one_chip v) + (D + one_chip v) := by + c'.chips - oneChip q = + (c'.chips - c.chips - oneChip v) + (D + oneChip v) := by rw [h_form_D] funext w simp only [Pi.sub_apply, sub_eq_add_neg, Pi.add_apply, Pi.neg_apply] abel_nf - have h_D''_unwin : ¬winnable G (c'.chips - one_chip q) := + have h_D''_unwin : ¬winnable G (c'.chips - oneChip q) := superstable_sub_chip_unwinnable q c' h_max_c'.1 apply h_D''_unwin rw [h_D''_eq] - exact winnable_add_winnable G (c'.chips - c.chips - one_chip v) (D + one_chip v) + exact winnable_add_winnable G (c'.chips - c.chips - oneChip v) (D + oneChip v) (winnable_of_effective G _ h_H_eff) (h_max.2 v) · exact maximal_unwinnable_q_reduced_toConfig_form q D h_max h_qred · rintro ⟨h_max_c, h_form⟩ @@ -318,21 +322,21 @@ configuration. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 4.9(2), in canonical form. -/ -theorem maximal_unwinnable_char {G : CFGraph} (h_conn : graph_connected G) (q : G.V) (D : CFDiv G) : - maximal_unwinnable G D ↔ - maximal_superstable G (qReducedConfig h_conn q D) ∧ +theorem maximal_unwinnable_char {G : CFGraph} (h_conn : graphConnected G) (q : G.V) (D : CFDiv G) : + maximalUnwinnable G D ↔ + maximalSuperstable G (qReducedConfig h_conn q D) ∧ qReducedRep h_conn q D = - (qReducedConfig h_conn q D).chips - one_chip q := by + (qReducedConfig h_conn q D).chips - oneChip q := by let D' := qReducedRep h_conn q D - have h_qred_D' : q_reduced G q D' := (qReducedRep_spec h_conn q D).2 + have h_qred_D' : qReduced G q D' := (qReducedRep_spec h_conn q D).2 have h_core := maximal_unwinnable_q_reduced_toConfig_iff h_conn q D' h_qred_D' constructor · intro h_max_unwinnable_D - have h_max_D' : maximal_unwinnable G D' := + have h_max_D' : maximalUnwinnable G D' := maximal_unwinnable_preserved G D D' h_max_unwinnable_D (qReducedRep_spec h_conn q D).1 simpa only [qReducedConfig] using h_core.mp h_max_D' · intro h_can - have h_max_D' : maximal_unwinnable G D' := by + have h_max_D' : maximalUnwinnable G D' := by simpa only using h_core.mpr h_can exact maximal_unwinnable_preserved G D' D h_max_D' (qReducedRep_spec h_conn q D).1.symm @@ -341,21 +345,19 @@ $q$-reduced representative and canonical configuration. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 4.9(4). -/ theorem maximal_unwinnable_deg - {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : - maximal_unwinnable G D → deg D = genus G - 1 := by + {G : CFGraph} (h_conn : graphConnected G) (D : CFDiv G) : + maximalUnwinnable G D → deg D = genus G - 1 := by intro h_max_unwin - let q := Classical.arbitrary G.V - have h_char := maximal_unwinnable_char h_conn q D - have h_max_cfg : maximal_superstable G (qReducedConfig h_conn q D) := (h_char.mp h_max_unwin).1 + have h_max_cfg : maximalSuperstable G (qReducedConfig h_conn q D) := (h_char.mp h_max_unwin).1 have h_rep_form : qReducedRep h_conn q D = - (qReducedConfig h_conn q D).chips - one_chip q := (h_char.mp h_max_unwin).2 + (qReducedConfig h_conn q D).chips - oneChip q := (h_char.mp h_max_unwin).2 have h_deg_D' : deg (qReducedRep h_conn q D) = genus G - 1 := calc deg (qReducedRep h_conn q D) = - deg ((qReducedConfig h_conn q D).chips - one_chip q) := by rw [h_rep_form] - _ = config_degree (qReducedConfig h_conn q D) - 1 := + deg ((qReducedConfig h_conn q D).chips - oneChip q) := by rw [h_rep_form] + _ = configDegree (qReducedConfig h_conn q D) - 1 := deg_chips_sub_one_chip (c := qReducedConfig h_conn q D) _ = genus G - 1 := by rw [degree_max_superstable (qReducedConfig h_conn q D) h_max_cfg] have h_deg_eq : deg D = deg (qReducedRep h_conn q D) := @@ -370,10 +372,10 @@ $D(\mathcal{O})$ by a fixed divisor, so injectivity is equivalent. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 4.9(3) for the injectivity claim. -/ theorem acyclic_orientation_maximal_unwinnable_correspondence_and_degree - {G : CFGraph} (h_conn : graph_connected G) (q : G.V) : - (Function.Injective (λ (O : {O : CFOrientation G // is_acyclic G O ∧ is_source G O q}) => - λ v => (indeg G O.val v) - if v = q then 1 else 0)) ∧ - (∀ D : CFDiv G, maximal_unwinnable G D → deg D = genus G - 1) := by + {G : CFGraph} (h_conn : graphConnected G) (q : G.V) : + (Function.Injective (fun (O : {O : CFOrientation G // isAcyclic G O ∧ isSource G O q}) => + fun v => (indeg G O.val v) - if v = q then 1 else 0)) ∧ + (∀ D : CFDiv G, maximalUnwinnable G D → deg D = genus G - 1) := by constructor { -- Part 1: Injection proof intros O₁ O₂ h_eq @@ -382,11 +384,12 @@ theorem acyclic_orientation_maximal_unwinnable_correspondence_and_degree have := congr_fun h_eq v by_cases hv : v = q · have h₁ := O₁.prop.2; have h₂ := O₂.prop.2 - dsimp only [is_source] at h₁ h₂ + dsimp only [isSource] at h₁ h₂ rw [hv, h₁, h₂] · simp only [hv, ↓reduceIte, tsub_zero] at this exact this - exact Subtype.ext (orientation_determined_by_indegrees O₁.val O₂.val O₁.prop.1 O₂.prop.1 h_indeg) + exact Subtype.ext (orientation_determined_by_indegrees O₁.val O₂.val O₁.prop.1 O₂.prop.1 + h_indeg) } { -- Part 2: Degree characterization -- This now correctly refers to the theorem defined above @@ -405,13 +408,13 @@ $D(\mathcal{O})$ to $K_G - D(\mathcal{O})$. /-- A *moderator* is a divisor of the form $D(\mathcal{O})$ for some acyclic orientation $\mathcal{O}$. -/ -def is_moderator {G : CFGraph} (D : CFDiv G) : Prop := - ∃ (O : CFOrientation G), is_acyclic G O ∧ D = ordiv G O +def isModerator {G : CFGraph} (D : CFDiv G) : Prop := + ∃ (O : CFOrientation G), isAcyclic G O ∧ D = ordiv G O /-- If $D$ is a moderator, then so is $K_G - D$ (via the reverse orientation). This is the key duality in the proof of Riemann-Roch. -/ lemma moderator_symmetry {G : CFGraph} (D : CFDiv G) : - is_moderator D → is_moderator (canonical_divisor G - D) := by + isModerator D → isModerator (canonicalDivisor G - D) := by rintro ⟨O, hO, h_D⟩ use O.reverse constructor @@ -421,53 +424,52 @@ lemma moderator_symmetry {G : CFGraph} (D : CFDiv G) : abel /-- Moderators have degree $g-1$. -/ -lemma moderator_degree {G : CFGraph} {D : CFDiv G} (h : is_moderator D) : deg D = genus G - 1 := by +lemma moderator_degree {G : CFGraph} {D : CFDiv G} (h : isModerator D) : deg D = genus G - 1 := by rcases h with ⟨O, hO, rfl⟩ exact degree_ordiv O /-- Moderators are unwinnable. -/ -lemma unwinnable_of_moderator {G : CFGraph} {D : CFDiv G} (h : is_moderator D) : ¬ winnable G D := by +lemma unwinnable_of_moderator {G : CFGraph} {D : CFDiv G} (h : isModerator D) : ¬ winnable G D := by rcases h with ⟨O, hO, rfl⟩ exact ordiv_unwinnable G O hO /-- For every unwinnable divisor $D$, there exist a moderator $M$ and an effective divisor $H$ with $M \sim D + H$. -/ -lemma moderator_of_unwinnable {G : CFGraph} (h_conn: graph_connected G) (D : CFDiv G) (unwin : ¬ winnable G D) : - ∃ (M H : CFDiv G), is_moderator M ∧ effective H ∧ linear_equiv G M (D+H) := by +lemma moderator_of_unwinnable {G : CFGraph} (h_conn : graphConnected G) (D : CFDiv G) (unwin : ¬ + winnable G D) : + ∃ (M H : CFDiv G), isModerator M ∧ effective H ∧ linearEquiv G M (D+H) := by let q := Classical.arbitrary G.V rcases superstable_of_divisor h_conn q D with ⟨c, k, h_equiv, h_super⟩ have h_k_neg : k < 0 := superstable_of_divisor_negative_k G q D unwin c k h_equiv h_super rcases maximal_superstable_exists G q c h_super with ⟨c', h_max', h_ge⟩ rcases maximal_superstable_orientation G q c' h_max' with ⟨O, hO, h_orient_eq_c'⟩ - let H : CFDiv G := -(k+1) • (one_chip q) + c'.chips - c.chips + let H : CFDiv G := -(k+1) • (oneChip q) + c'.chips - c.chips have h_H_eff : effective H := by have diff_eff : effective (c'.chips - c.chips) := by rwa [sub_eff_iff_geq] - have src_eff : effective (-(k+1) • one_chip q) := by + have src_eff : effective (-(k+1) • oneChip q) := by intro v rw [Pi.smul_apply, smul_eq_mul] apply mul_nonneg · -- Prove -(k + 1) ≥ 0 linarith [h_k_neg] - · -- Prove one_chip q v ≥ 0 + · -- Prove oneChip q v ≥ 0 exact eff_one_chip q v have := (Eff G).add_mem src_eff diff_eff rwa [← add_sub_assoc] at this - let M := c'.chips - one_chip q - have M_eq : linear_equiv G M (D + H) := by - simp only [linear_equiv, principal_iff_eq_prin, H, M] at ⊢ h_equiv + let M := c'.chips - oneChip q + have M_eq : linearEquiv G M (D + H) := by + simp only [linearEquiv, principal_iff_eq_prin, H, M] at ⊢ h_equiv rcases h_equiv with ⟨σ, eq_σ⟩ use (-σ) rw [map_neg, ← eq_σ] funext v; simp only [neg_add_rev, Int.reduceNeg, zsmul_eq_mul, Int.cast_add, Int.cast_neg, Int.cast_one, Pi.sub_apply, Pi.add_apply, Pi.mul_apply, Pi.neg_apply, Pi.one_apply, Pi.intCast_apply, Int.cast_eq, neg_sub]; ring - have h_M_O : M = ordiv G O := by have c'_eq : c' = toConfig (orqed O hO) := by rw [← h_orient_eq_c'] exact config_and_divisor_from_O O hO - have : toDiv (genus G - 1) (toConfig (orqed O hO)) = ordiv G O := by calc toDiv (genus G - 1) (toConfig (orqed O hO)) @@ -480,15 +482,15 @@ lemma moderator_of_unwinnable {G : CFGraph} (h_conn: graph_connected G) (D : CFD rw [← this] dsimp only [toDiv, M] rw [c'_eq] - have : (genus G - 1 - config_degree (toConfig (orqed O hO))) = -1 := by - have h_cfg_deg : config_degree (toConfig (orqed O hO)) = genus G := by + have : (genus G - 1 - configDegree (toConfig (orqed O hO))) = -1 := by + have h_cfg_deg : configDegree (toConfig (orqed O hO)) = genus G := by rw [← config_and_divisor_from_O O hO] exact config_degree_from_O O hO rw [h_cfg_deg] ring simp only [this, Int.reduceNeg, neg_smul, one_smul] rw [sub_eq_add_neg] - have h_M_moderator : is_moderator M := by + have h_M_moderator : isModerator M := by exact ⟨O, ⟨hO.1, h_M_O⟩⟩ use M, H @@ -505,37 +507,33 @@ dualizes via `moderator_symmetry` to bound $r(K_G - D)$ by $\deg(F)$. /-- The strict Riemann-Roch inequality: $\deg(D) - g < r(D) - r(K_G - D)$. -/ theorem rank_degree_inequality - {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : - deg D - genus G < rank G D - rank G (canonical_divisor G - D) := by + {G : CFGraph} (h_conn : graphConnected G) (D : CFDiv G) : + deg D - genus G < rank G D - rank G (canonicalDivisor G - D) := by rcases rank_get_effective G D with ⟨E, E_eff, E_deg, D_E_unwin⟩ rcases moderator_of_unwinnable h_conn (D - E) D_E_unwin with ⟨M, F, M_moderator, F_eff, M_equiv⟩ - set M' := canonical_divisor G - M with M'_eq - have M'_moderator : is_moderator M' := moderator_symmetry M M_moderator - - set D' := canonical_divisor G - D with D'_eq - have M'_equiv : linear_equiv G (D' - F + E) M' := by + set M' := canonicalDivisor G - M with M'_eq + have M'_moderator : isModerator M' := moderator_symmetry M M_moderator + set D' := canonicalDivisor G - D with D'_eq + have M'_equiv : linearEquiv G (D' - F + E) M' := by rw [M'_eq] - dsimp only [linear_equiv, D'] - dsimp only [linear_equiv] at M_equiv + dsimp only [linearEquiv, D'] + dsimp only [linearEquiv] at M_equiv rw [principal_iff_eq_prin] at M_equiv ⊢ rcases M_equiv with ⟨σ, eq_σ⟩ use σ rw [← eq_σ] abel - have h_D'_F : ¬ winnable G (D' - F) := by by_contra! have := winnable_add_winnable G (D' - F) E this (winnable_of_effective G E E_eff) apply unwinnable_of_moderator M'_moderator apply winnable_equiv_winnable G (D' - F + E) M' this M'_equiv - have ineq : deg F > rank G D' := by contrapose! h_D'_F apply (rank_geq_iff G D' (deg F)).mpr at h_D'_F - dsimp only [rank_geq] at h_D'_F + dsimp only [rankGeq] at h_D'_F specialize h_D'_F F ⟨F_eff, rfl⟩ exact h_D'_F - -- Finally, degree calculations to finish the inequality have degF : deg F = - deg D + deg E + deg M := by rw [linear_equiv_preserves_deg G M (D - E + F) M_equiv] diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean index b7a907dbf6..9527d6c3df 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean @@ -5,9 +5,6 @@ Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ import LeanPool.ChipFiring.ChipFiringWithLean.Basic - -open Multiset Finset - /-! ## The rank function @@ -29,58 +26,63 @@ A divisor $D$ is *maximal unwinnable* if it is unwinnable but $D + \delta_v$ is for every vertex $v$. Such divisors arise in the proof of the Riemann-Roch theorem. -/ + +open Multiset Finset + + + /-- Winnability is preserved under linear equivalence. -/ lemma winnable_equiv_winnable (G : CFGraph) (D1 D2 : CFDiv G) : - winnable G D1 → linear_equiv G D1 D2 → winnable G D2 := by + winnable G D1 → linearEquiv G D1 D2 → winnable G D2 := by rintro ⟨D1', h_D1'_eff, h_lequiv1⟩ h_lequiv exact ⟨D1', h_D1'_eff, h_lequiv.symm.trans h_lequiv1⟩ /-- A divisor is maximal unwinnable if it is unwinnable but adding a chip to any vertex makes it winnable. -/ -def maximal_unwinnable (G : CFGraph) (D : CFDiv G) : Prop := - ¬winnable G D ∧ ∀ v : G.V, winnable G (D + one_chip v) +def maximalUnwinnable (G : CFGraph) (D : CFDiv G) : Prop := + ¬winnable G D ∧ ∀ v : G.V, winnable G (D + oneChip v) /-- Being maximal unwinnable is preserved under linear equivalence. -/ lemma maximal_unwinnable_preserved (G : CFGraph) (D1 D2 : CFDiv G) : - maximal_unwinnable G D1 → linear_equiv G D1 D2 → maximal_unwinnable G D2 := by + maximalUnwinnable G D1 → linearEquiv G D1 D2 → maximalUnwinnable G D2 := by rintro ⟨h_unwin_D1, h_winnable_add⟩ h_lequiv refine ⟨?_, ?_⟩ · intro h_win_D2 exact h_unwin_D1 <| winnable_equiv_winnable G D2 D1 h_win_D2 h_lequiv.symm · intro v - exact winnable_equiv_winnable G (D1 + one_chip v) (D2 + one_chip v) (h_winnable_add v) <| by - unfold linear_equiv at * + exact winnable_equiv_winnable G (D1 + oneChip v) (D2 + oneChip v) (h_winnable_add v) <| by + unfold linearEquiv at * simpa only [add_sub_add_right_eq_sub] using h_lequiv /-- The set of effective divisors of degree $k$. -This is used to define `rank_geq`: the relation $r(D) \ge k$ means that $D-E$ is +This is used to define `rankGeq`: the relation $r(D) \ge k$ means that $D-E$ is winnable for every effective divisor $E$ of degree $k$. -/ -def eff_of_degree (G : CFGraph) (k : ℤ) : Set (CFDiv G) := +def effOfDegree (G : CFGraph) (k : ℤ) : Set (CFDiv G) := {E | effective E ∧ deg E = k} /-- For any nonnegative integer $k$, the set of effective divisors of degree $k$ is nonempty. -/ private lemma eff_of_degree_nonempty (G : CFGraph) {k : ℤ} (h_nonneg : 0 ≤ k) : - (eff_of_degree G k).Nonempty := by + (effOfDegree G k).Nonempty := by let v : G.V := Classical.arbitrary G.V - refine ⟨k.toNat • one_chip v, ?_, ?_⟩ + refine ⟨k.toNat • oneChip v, ?_, ?_⟩ · exact (Eff G).nsmul_mem (eff_one_chip v) k.toNat · simpa only [nsmul_eq_mul, deg_one_chip, Int.toNat_of_nonneg h_nonneg, mul_one] using - (AddMonoidHom.map_nsmul deg k.toNat (one_chip v)) + (AddMonoidHom.map_nsmul deg k.toNat (oneChip v)) /-- The relation $r(D) \ge k$: the game remains winnable after removing any effective divisor of degree $k$. -/ -def rank_geq (G : CFGraph) (D : CFDiv G) (k : ℤ) : Prop := - ∀ E ∈ eff_of_degree G k, winnable G (D-E) +def rankGeq (G : CFGraph) (D : CFDiv G) (k : ℤ) : Prop := + ∀ E ∈ effOfDegree G k, winnable G (D-E) -/-- The relation $r(D)=r$: `rank_geq G D r` holds, but `rank_geq G D (r+1)` does not. -/ -def rank_eq (G : CFGraph) (D : CFDiv G) (r : ℤ) : Prop := - rank_geq G D r ∧ ¬(rank_geq G D (r+1)) +/-- The relation $r(D)=r$: `rankGeq G D r` holds, but `rankGeq G D (r+1)` does not. -/ +def rankEq (G : CFGraph) (D : CFDiv G) (r : ℤ) : Prop := + rankGeq G D r ∧ ¬(rankGeq G D (r+1)) -/-- The relation `rank_geq G D k` holds vacuously for $k < 0$, since there are no effective +/-- The relation `rankGeq G D k` holds vacuously for $k < 0$, since there are no effective divisors of negative degree. -/ -private lemma rank_geq_neg (G : CFGraph) (D : CFDiv G) (k : ℤ): (k < 0) → rank_geq G D k := by +private lemma rank_geq_neg (G : CFGraph) (D : CFDiv G) (k : ℤ) : (k < 0) → rankGeq G D k := by intro k_neg E ⟨h_eff_E, h_deg_E⟩ have := deg_of_eff_nonneg E h_eff_E linarith @@ -88,7 +90,8 @@ private lemma rank_geq_neg (G : CFGraph) (D : CFDiv G) (k : ℤ): (k < 0) → ra /-- A winnable divisor has nonnegative degree. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 1.16. -/ -private lemma deg_winnable_nonneg (G : CFGraph) (D : CFDiv G) (h_winnable : winnable G D) : deg D ≥ 0 := by +private lemma deg_winnable_nonneg (G : CFGraph) (D : CFDiv G) (h_winnable : winnable G D) : deg + D ≥ 0 := by rcases h_winnable with ⟨D', h_D'_eff, h_lequiv⟩ have same_deg: deg D = deg D' := linear_equiv_preserves_deg G D D' h_lequiv rw [same_deg] @@ -97,9 +100,9 @@ private lemma deg_winnable_nonneg (G : CFGraph) (D : CFDiv G) (h_winnable : winn /-- Every effective divisor is winnable (take $D' = D$ in the definition). -/ lemma winnable_of_effective (G : CFGraph) (D : CFDiv G) (h_eff : effective D) : winnable G D := by exact ⟨D, h_eff, by - unfold linear_equiv + unfold linearEquiv rw [sub_self] - exact AddSubgroup.zero_mem (principal_divisors G)⟩ + exact AddSubgroup.zero_mem (principalDivisors G)⟩ /-- The sum of two winnable divisors is winnable. -/ lemma winnable_add_winnable (G : CFGraph) (D1 D2 : CFDiv G) @@ -108,25 +111,25 @@ lemma winnable_add_winnable (G : CFGraph) (D1 D2 : CFDiv G) rcases h_winnable2 with ⟨D2', h_D2'_eff, h_lequiv2⟩ use D1' + D2' refine ⟨(Eff G).add_mem h_D1'_eff h_D2'_eff, ?_⟩ - · - unfold linear_equiv at * + · unfold linearEquiv at * have : D1' + D2' - (D1 + D2) = (D1' - D1) + (D2' - D2) := by rw [sub_add_sub_comm] rw [this] - exact AddSubgroup.add_mem (principal_divisors G) h_lequiv1 h_lequiv2 + exact AddSubgroup.add_mem (principalDivisors G) h_lequiv1 h_lequiv2 /-- If $r(D) \ge r$ for some $r \ge 0$, then $r \le \deg(D)$. In particular, `rank G D ≤ deg D` when `rank G D ≥ 0`. -/ -lemma rank_le_degree (G : CFGraph) (D : CFDiv G) : ∀ (r : ℤ), r ≥ 0 → rank_geq G D r → r ≤ deg D := by +lemma rank_le_degree (G : CFGraph) (D : CFDiv G) : ∀ (r : ℤ), r ≥ 0 → rankGeq G D r → r ≤ deg D + := by intro r r_nonneg h_rank contrapose! h_rank - unfold rank_geq; push Not + unfold rankGeq; push Not rcases eff_of_degree_nonempty G r_nonneg with ⟨E, h_E_eff, h_E_deg⟩ use E constructor -- First conjunct: show that E is effecitive of the correct degree - exact ⟨h_E_eff, h_E_deg⟩ + · exact ⟨h_E_eff, h_E_deg⟩ -- Second conjunct: show that D-E is not winnable contrapose! h_rank have deg_nonneg := deg_winnable_nonneg G (D-E) h_rank @@ -134,12 +137,12 @@ lemma rank_le_degree (G : CFGraph) (D : CFDiv G) : ∀ (r : ℤ), r ≥ 0 → ra rw [h_E_deg] at deg_nonneg exact deg_nonneg -/-- The relation `rank_geq` is downward closed: if $r(D)\ge r_1$ and $r_2 \le r_1$, +/-- The relation `rankGeq` is downward closed: if $r(D)\ge r_1$ and $r_2 \le r_1$, then $r(D)\ge r_2$. -/ private lemma rank_geq_trans (G : CFGraph) (D : CFDiv G) (r1 r2 : ℤ) : - rank_geq G D r1 → r2 ≤ r1 → rank_geq G D r2 := by + rankGeq G D r1 → r2 ≤ r1 → rankGeq G D r2 := by intro h_r1 h_leq - unfold rank_geq at * + unfold rankGeq at * contrapose! h_r1 rcases h_r1 with ⟨E, ⟨h_E_eff,h_E_nonwin⟩⟩ rcases eff_of_degree_nonempty G (sub_nonneg.mpr h_leq) with ⟨E_diff, h_Ediff_eff, h_Ediff_deg⟩ @@ -147,14 +150,14 @@ private lemma rank_geq_trans (G : CFGraph) (D : CFDiv G) (r1 r2 : ℤ) : constructor · -- Show that E + E_diff is effective of degree r2 constructor - apply (Eff G).add_mem - exact h_E_eff.left - exact h_Ediff_eff + · apply (Eff G).add_mem + · exact h_E_eff.left + exact h_Ediff_eff -- Show degree have E_deg := h_E_eff.right simp only [_root_.map_add] at E_deg h_Ediff_deg ⊢ linarith - . -- Show that D - (E + E_diff) is not winnable + · -- Show that D - (E + E_diff) is not winnable contrapose! h_E_nonwin have E_diff_winnable := winnable_of_effective G E_diff h_Ediff_eff have sum_winnable := winnable_add_winnable G _ _ h_E_nonwin E_diff_winnable @@ -163,13 +166,13 @@ private lemma rank_geq_trans (G : CFGraph) (D : CFDiv G) (r1 r2 : ℤ) : /-- If $r(D) \ge r_1$ holds but $r(D) \ge r_2$ does not, then $r_1 < r_2$. -/ lemma lt_of_rank_geq_not (G : CFGraph) (D : CFDiv G) (r1 r2 : ℤ) : - rank_geq G D r1 → ¬(rank_geq G D r2) → r1 < r2 := by + rankGeq G D r1 → ¬(rankGeq G D r2) → r1 < r2 := by intro h_r1 h_r2 contrapose! h_r2 exact rank_geq_trans G D r1 r2 h_r1 h_r2 -private lemma rank_eq_neg_one_iff_unwinnable (G : CFGraph) (D : CFDiv G) : - rank_eq G D (-1) ↔ ¬(winnable G D) := by +private lemma rank_eq_neg_one_iff_unwinnable (G : CFGraph) (D : CFDiv G) : + rankEq G D (-1) ↔ ¬(winnable G D) := by constructor · intro h rcases h with ⟨_, h_rank⟩ @@ -193,13 +196,13 @@ private lemma rank_eq_neg_one_iff_unwinnable (G : CFGraph) (D : CFDiv G) : /-- The inequality $r(D)\ge 0$ holds if and only if $D$ is winnable. -/ lemma rank_nonneg_iff_winnable (G : CFGraph) (D : CFDiv G) : - rank_geq G D 0 ↔ winnable G D := by + rankGeq G D 0 ↔ winnable G D := by constructor · intro h_rank specialize h_rank 0 rw [sub_zero] at h_rank exact h_rank <| by - simp only [eff_of_degree, effective, ge_iff_le, Set.mem_ofPred_eq, Pi.zero_apply, Std.le_refl, + simp only [effOfDegree, effective, ge_iff_le, Set.mem_ofPred_eq, Pi.zero_apply, Std.le_refl, implies_true, _root_.map_zero, and_self] · intro h_winnable E ⟨h_eff_E, h_deg_E⟩ have E_zero := eff_degree_zero _ h_eff_E h_deg_E @@ -207,17 +210,17 @@ lemma rank_nonneg_iff_winnable (G : CFGraph) (D : CFDiv G) : /-- If $r(D) \ge m$ fails for some natural number $m$, then there exists an exact rank $r < m$. -/ -private lemma rank_exists_helper (G : CFGraph) (D : CFDiv G) (m : ℕ): ¬ (rank_geq G D m) → ∃ r < (m:ℤ), rank_eq G D r := by +private lemma rank_exists_helper (G : CFGraph) (D : CFDiv G) (m : ℕ) : ¬(rankGeq G D m) → ∃ r < + (m : ℤ), rankEq G D r := by induction m with | zero => · intro h_rank_geq exact ⟨-1, by norm_num, rank_geq_neg G D (-1) (by norm_num), h_rank_geq⟩ | succ m ih => intro h_rank_geq - by_cases h_rank_m : rank_geq G D m + by_cases h_rank_m : rankGeq G D m · exact ⟨m, by norm_num, h_rank_m, h_rank_geq⟩ - · - specialize ih h_rank_m + · specialize ih h_rank_m rcases ih with ⟨r, h_r_lt, h_rank_eq⟩ have r_le : r < m + 1 := by linarith [h_r_lt] @@ -225,9 +228,9 @@ private lemma rank_exists_helper (G : CFGraph) (D : CFDiv G) (m : ℕ): ¬ (ran /-- Every divisor has a well-defined rank: there exists an integer $r$ with $r(D)=r$. -/ lemma rank_exists (G : CFGraph) (D : CFDiv G) : - ∃ r : ℤ, rank_eq G D r := by + ∃ r : ℤ, rankEq G D r := by let m := (deg D).toNat + 1 - have h_not_geq : ¬(rank_geq G D m) := by + have h_not_geq : ¬(rankGeq G D m) := by intro h_rank_geq have h_le := rank_le_degree G D m (by linarith) h_rank_geq have m_ge : m ≥ deg D + 1:= by @@ -240,7 +243,7 @@ lemma rank_exists (G : CFGraph) (D : CFDiv G) : /-- The rank of a divisor is unique: if $r(D)=r_1$ and $r(D)=r_2$, then $r_1=r_2$. This is not explicitly needed elsewhere, but is included for context. -/ private lemma rank_unique (G : CFGraph) (D : CFDiv G) : - ∀ r1 r2 : ℤ, rank_eq G D r1 → rank_eq G D r2 → r1 = r2 := by + ∀ r1 r2 : ℤ, rankEq G D r1 → rankEq G D r2 → r1 = r2 := by rintro r1 r2 ⟨h_r1_geq, h_r1_not_geq⟩ ⟨h_r2_geq, h_r2_not_geq⟩ have ineq1 : r1 < r2 + 1 := lt_of_rank_geq_not G D r1 (r2+1) h_r1_geq h_r2_not_geq have ineq2 : r2 < r1 + 1 := lt_of_rank_geq_not G D r2 (r1+1) h_r2_geq h_r1_not_geq @@ -250,13 +253,13 @@ private lemma rank_unique (G : CFGraph) (D : CFDiv G) : noncomputable def rank (G : CFGraph) (D : CFDiv G) : ℤ := Classical.choose (rank_exists G D) -/-- The defining property of `rank`: it satisfies the relation `rank_eq`. -/ -private lemma rank_spec (G : CFGraph) (D : CFDiv G) : rank_eq G D (rank G D) := +/-- The defining property of `rank`: it satisfies the relation `rankEq`. -/ +private lemma rank_spec (G : CFGraph) (D : CFDiv G) : rankEq G D (rank G D) := Classical.choose_spec (rank_exists G D) -/-- The relation `rank_geq G D k` is equivalent to the inequality `rank G D ≥ k`. -/ +/-- The relation `rankGeq G D k` is equivalent to the inequality `rank G D ≥ k`. -/ lemma rank_geq_iff (G : CFGraph) (D : CFDiv G) (k : ℤ) : - rank_geq G D k ↔ rank G D ≥ k := by + rankGeq G D k ↔ rank G D ≥ k := by constructor · -- Forward direction intro h_rank_geq @@ -266,10 +269,10 @@ lemma rank_geq_iff (G : CFGraph) (D : CFDiv G) (k : ℤ) : intro h_rank_leq exact rank_geq_trans G D (rank G D) k (rank_spec G D).left h_rank_leq -/-- The relation `rank_eq G D r` is equivalent to the equality `rank G D = r`. -/ +/-- The relation `rankEq G D r` is equivalent to the equality `rank G D = r`. -/ private lemma rank_eq_iff (G : CFGraph) (D : CFDiv G) (r : ℤ) : - rank_eq G D r ↔ rank G D = r := by - dsimp only [rank_eq] + rankEq G D r ↔ rank G D = r := by + dsimp only [rankEq] have split_eq x: x = r ↔ (x ≥ r ∧ ¬(x ≥ r + 1)) := by rw [not_le] rw [Int.lt_add_one_iff] @@ -280,7 +283,7 @@ private lemma rank_eq_iff (G : CFGraph) (D : CFDiv G) (r : ℤ) : /-- A divisor is winnable if and only if it is linearly equivalent to an effective divisor. -/ lemma winnable_iff_exists_effective (G : CFGraph) (D : CFDiv G) : - winnable G D ↔ ∃ D' : CFDiv G, effective D' ∧ linear_equiv G D D' := by + winnable G D ↔ ∃ D' : CFDiv G, effective D' ∧ linearEquiv G D D' := by simp only [winnable, mem_Eff] @@ -288,7 +291,7 @@ lemma winnable_iff_exists_effective (G : CFGraph) (D : CFDiv G) : lemma rank_get_effective (G : CFGraph) (D : CFDiv G) : ∃ E : CFDiv G, effective E ∧ deg E = rank G D + 1 ∧ ¬(winnable G (D-E)) := by obtain ⟨_, h_r_not_geq⟩ := rank_spec G D - dsimp only [rank_geq] at h_r_not_geq + dsimp only [rankGeq] at h_r_not_geq push Not at h_r_not_geq rcases h_r_not_geq with ⟨E, ⟨h_E_eff, h_E_deg⟩, h_E_not_winnable⟩ exact ⟨E, h_E_eff, h_E_deg, h_E_not_winnable⟩ @@ -320,32 +323,32 @@ lemma rank_neg_one_of_not_nonneg (G : CFGraph) (D : CFDiv G) lemma zero_divisor_rank (G : CFGraph) : rank G (0:CFDiv G) = 0 := by rw [← rank_eq_iff] constructor - have h_eff : effective (0:CFDiv G) := by - simp only [effective, Pi.zero_apply, ge_iff_le, Std.le_refl, implies_true] - rw [rank_nonneg_iff_winnable G (0:CFDiv G)] - exact winnable_of_effective G (0:CFDiv G) h_eff + · have h_eff : effective (0:CFDiv G) := by + simp only [effective, Pi.zero_apply, ge_iff_le, Std.le_refl, implies_true] + rw [rank_nonneg_iff_winnable G (0:CFDiv G)] + exact winnable_of_effective G (0:CFDiv G) h_eff have ineq := rank_le_degree G (0:CFDiv G) 1 (by norm_num) simp only [deg, AddMonoidHom.coe_mk, ZeroHom.coe_mk, Pi.zero_apply, sum_const_zero, Int.reduceLE, imp_false] at ineq exact ineq theorem one_le_apply_of_q_reduced_of_rank_geq_one {G : CFGraph} {q : G.V} - {D : CFDiv G} (hred : q_reduced G q D) (hrank : rank G D ≥ 1) : + {D : CFDiv G} (hred : qReduced G q D) (hrank : rank G D ≥ 1) : 1 ≤ D q := by classical - have hval : ∀ v : G.V, v ≠ q → (D - one_chip q) v = D v := by + have hval : ∀ v : G.V, v ≠ q → (D - oneChip q) v = D v := by intro v hv simp [Pi.sub_apply, one_chip_apply_other' q v hv] - have hwin : winnable G (D - one_chip q) := - (rank_geq_iff G D 1).mpr hrank (one_chip q) ⟨eff_one_chip q, deg_one_chip q⟩ - have hred' : q_reduced G q (D - one_chip q) := by + have hwin : winnable G (D - oneChip q) := + (rank_geq_iff G D 1).mpr hrank (oneChip q) ⟨eff_one_chip q, deg_one_chip q⟩ + have hred' : qReduced G q (D - oneChip q) := by refine ⟨fun v hv => by rw [hval v hv]; exact hred.1 v hv, ?_⟩ intro S hq hSne hlegal apply hred.2 S hq hSne intro v hvS rw [← hval v (fun hvq => hq (hvq ▸ hvS))] exact hlegal v hvS - have heff : effective (D - one_chip q) := + have heff : effective (D - oneChip q) := effective_of_winnable_and_q_reduced G q _ hwin hred' have hq := heff q simp only [Pi.sub_apply, one_chip_apply_v] at hq diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean b/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean index ed222ccf39..c68805e66a 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean @@ -5,11 +5,6 @@ Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ import LeanPool.ChipFiring.ChipFiringWithLean.RRGHelpers - -universe u - -open Multiset Finset - /-! # Riemann-Roch for graphs @@ -18,30 +13,37 @@ The Riemann-Roch theorem for graphs and its main corollaries. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Chapter 5. -/ + +universe u + +open Multiset Finset + + + /-- **Riemann-Roch theorem for graphs:** $r(D) - r(K_G - D) = \deg(D) + 1 - g$. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 5.9. -/ -theorem riemann_roch_for_graphs {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : - rank G D - rank G (canonical_divisor G - D) = deg D - genus G + 1 := by - set K := canonical_divisor G with K_eq +theorem riemann_roch_for_graphs {G : CFGraph} (h_conn : graphConnected G) (D : CFDiv G) : + rank G D - rank G (canonicalDivisor G - D) = deg D - genus G + 1 := by + set K := canonicalDivisor G with K_eq have h_ineq := rank_degree_inequality h_conn D have h_ineq_rev : deg (K-D) - genus G < rank G (K-D) - rank G D := by convert rank_degree_inequality h_conn (K-D) abel have deg_sub : deg (K-D) = deg K - deg D := by rw [deg.map_sub] - have h_deg_K : deg (canonical_divisor G) = 2 * genus G - 2 := degree_of_canonical_divisor G + have h_deg_K : deg (canonicalDivisor G) = 2 * genus G - 2 := degree_of_canonical_divisor G linarith /-- $D$ is maximal unwinnable if and only if $K_G - D$ is maximal unwinnable. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 5.11. -/ theorem maximal_unwinnable_symmetry - {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : - maximal_unwinnable G D ↔ maximal_unwinnable G (canonical_divisor G - D) := by - set K := canonical_divisor G with K_def - suffices ∀ (D : CFDiv G), maximal_unwinnable G D → maximal_unwinnable G (canonical_divisor G - D) by + {G : CFGraph} (h_conn : graphConnected G) (D : CFDiv G) : + maximalUnwinnable G D ↔ maximalUnwinnable G (canonicalDivisor G - D) := by + set K := canonicalDivisor G with K_def + suffices ∀ (D : CFDiv G), maximalUnwinnable G D → maximalUnwinnable G (canonicalDivisor G - D) by constructor - exact this D + · exact this D intro h apply this (K-D) at h rw [sub_sub_self] at h @@ -52,21 +54,17 @@ theorem maximal_unwinnable_symmetry have h_rank_neg : rank G D = -1 := by rw [rank_neg_one_iff_unwinnable] exact h_max_unwin.1 - -- Get degree = g-1 from maximal unwinnable have h_deg : deg D = genus G - 1 := maximal_unwinnable_deg h_conn D h_max_unwin - -- Use Riemann-Roch have h_RR := riemann_roch_for_graphs h_conn D rw [h_rank_neg] at h_RR - -- Get degree of K-D have h_deg_K := degree_of_canonical_divisor G - have h_deg_KD : deg (canonical_divisor G - D) = genus G - 1 := by + have h_deg_KD : deg (canonicalDivisor G - D) = genus G - 1 := by rw [deg.map_sub] rw [h_deg_K, h_deg] linarith - constructor · -- K-D is unwinnable rw [←rank_neg_one_iff_unwinnable] @@ -74,7 +72,7 @@ theorem maximal_unwinnable_symmetry · -- Adding chip makes K-D winnable intro v -- Goal: winnable G ((K-D) + δᵥ) -- Let E = (K-D) + δᵥ - set E : CFDiv G := (canonical_divisor G - D) + one_chip v with E_def + set E : CFDiv G := (canonicalDivisor G - D) + oneChip v with E_def suffices winnable G E by exact this -- To show E is winnable, we will use Riemann-Roch on E @@ -101,26 +99,21 @@ private lemma rank_subadditive (G : CFGraph) (D D' : CFDiv G) -- Express the two (nonnegative) ranks as natural numbers obtain ⟨k₁, h_k₁⟩ : ∃ k : ℕ, (k : ℤ) = rank G D := ⟨_, Int.toNat_of_nonneg h_D⟩ obtain ⟨k₂, h_k₂⟩ : ∃ k : ℕ, (k : ℤ) = rank G D' := ⟨_, Int.toNat_of_nonneg h_D'⟩ - - -- Show rank is ≥ k₁ + k₂ by proving rank_geq - have h_rank_geq : rank_geq G (D + D') (k₁ + k₂) := by + -- Show rank is ≥ k₁ + k₂ by proving rankGeq + have h_rank_geq : rankGeq G (D + D') (k₁ + k₂) := by -- Take any effective divisor E'' of degree k₁ + k₂ rintro E'' ⟨h_eff, h_deg⟩ - -- Decompose E'' into E₁ and E₂ of degrees k₁ and k₂ obtain ⟨E₁, E₂, h_E₁_eff, h_E₂_eff, h_E₁_deg, h_E₂_deg, h_sum⟩ := effective_divisor_decomposition G E'' k₁ k₂ h_eff h_deg - - -- Apply rank_geq to get winnability for both parts + -- Apply rankGeq to get winnability for both parts have h_D_win := (rank_geq_iff G D k₁).mpr (le_of_eq h_k₁) E₁ ⟨h_E₁_eff, h_E₁_deg⟩ have h_D'_win := (rank_geq_iff G D' k₂).mpr (le_of_eq h_k₂) E₂ ⟨h_E₂_eff, h_E₂_deg⟩ - -- Show winnability of sum rw [h_sum] have h := winnable_add_winnable G (D-E₁) (D'-E₂) h_D_win h_D'_win rw [show D - E₁ + (D' - E₂) = (D + D') - (E₁ + E₂) by abel] at h exact h - have h_final := (rank_geq_iff G (D+D') (k₁+k₂)).mp h_rank_geq linarith @@ -129,18 +122,18 @@ $r(D) \leq \frac12 \deg(D)$. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 5.13. -/ theorem clifford_theorem - {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) + {G : CFGraph} (h_conn : graphConnected G) (D : CFDiv G) (h_D : rank G D ≥ 0) - (h_KD : rank G (canonical_divisor G - D) ≥ 0) : + (h_KD : rank G (canonicalDivisor G - D) ≥ 0) : (rank G D : ℚ) ≤ (deg D : ℚ) / 2 := by -- Get canonical divisor K's rank using Riemann-Roch - have h_K_rank : rank G (canonical_divisor G) = genus G - 1 := by + have h_K_rank : rank G (canonicalDivisor G) = genus G - 1 := by -- Apply Riemann-Roch with D = K - have h_rr := riemann_roch_for_graphs h_conn (canonical_divisor G) + have h_rr := riemann_roch_for_graphs h_conn (canonicalDivisor G) -- For K-K = 0, rank is 0 - have h_K_minus_K : rank G (canonical_divisor G - canonical_divisor G) = 0 := by + have h_K_minus_K : rank G (canonicalDivisor G - canonicalDivisor G) = 0 := by -- Show that this divisor is the zero divisor - have h1 : (canonical_divisor G - canonical_divisor G) = 0 := by + have h1 : (canonicalDivisor G - canonicalDivisor G) = 0 := by simp only [sub_self] -- Show that the zero divisor has rank 0 have h2 : rank G 0 = 0 := zero_divisor_rank G @@ -152,19 +145,16 @@ theorem clifford_theorem rw [degree_of_canonical_divisor] at h_rr -- Solve for rank G K linarith - -- Apply rank subadditivity - have h_subadd := rank_subadditive G D (canonical_divisor G - D) h_D h_KD + have h_subadd := rank_subadditive G D (canonicalDivisor G - D) h_D h_KD -- The sum D + (K-D) = K - have h_sum : (D + (canonical_divisor G - D)) = canonical_divisor G := by + have h_sum : (D + (canonicalDivisor G - D)) = canonicalDivisor G := by funext v simp only [Pi.add_apply, Pi.sub_apply, add_sub_cancel] rw [h_sum] at h_subadd rw [h_K_rank] at h_subadd - -- Use Riemann-Roch to get r(K-D) in terms of r(D) have h_rr := riemann_roch_for_graphs h_conn D - -- Combining subadditivity and Riemann-Roch gives 2 r(D) ≤ deg D; conclude in ℚ have h_two : 2 * rank G D ≤ deg D := by linarith have h_two' : (2 : ℚ) * (rank G D : ℚ) ≤ (deg D : ℚ) := by exact_mod_cast h_two @@ -177,7 +167,7 @@ theorem clifford_theorem See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 5.14. -/ theorem rank_nonspecial_range - {G : CFGraph} (h_conn : graph_connected G) (D : CFDiv G) : + {G : CFGraph} (h_conn : graphConnected G) (D : CFDiv G) : -- Part 1 (deg D < 0 → rank G D = -1) ∧ -- Part 2 @@ -187,13 +177,12 @@ theorem rank_nonspecial_range constructor · -- Part 1: deg(D) < 0 implies r(D) = -1 exact rank_neg_one_of_deg_neg G D - constructor · -- Part 2: 0 ≤ deg(D) ≤ 2g-2 implies r(D) ≤ deg(D)/2 intro ⟨h_deg_nonneg, h_deg_upper⟩ by_cases h_rank : rank G D ≥ 0 · -- Case where r(D) ≥ 0 - let K := canonical_divisor G + let K := canonicalDivisor G by_cases h_rankKD : rank G (K - D) ≥ 0 · -- Case where r(K-D) ≥ 0: use Clifford's theorem exact clifford_theorem h_conn D h_rank h_rankKD @@ -205,16 +194,14 @@ theorem rank_nonspecial_range rw [h_rank_eq] push_cast linarith - · -- Case where r(D) < 0 rw [rank_neg_one_of_not_nonneg G D h_rank] push_cast linarith - · -- Part 3: deg(D) > 2g-2 implies r(D) = deg(D) - g intro h_deg_large -- K-D has negative degree, hence rank -1 - have h_rankKD : rank G (canonical_divisor G - D) = -1 := by + have h_rankKD : rank G (canonicalDivisor G - D) = -1 := by apply rank_neg_one_of_deg_neg rw [deg.map_sub, degree_of_canonical_divisor] linarith @@ -232,25 +219,25 @@ of a graph. /-- The relation $\operatorname{gon}(G) \le k$: there exists a divisor of degree $k$ with rank at least $1$. -/ -def gonality_leq (G : CFGraph) (k : ℤ) : Prop := ∃ D : CFDiv G, rank G D ≥ 1 ∧ deg D = k +def gonalityLeq (G : CFGraph) (k : ℤ) : Prop := ∃ D : CFDiv G, rank G D ≥ 1 ∧ deg D = k /-- The relation $\operatorname{gon}(G) \ge k$: no divisor of degree less than $k$ has rank at least $1$. -/ -def gonality_geq (G : CFGraph) (k : ℤ) : Prop := - ∀ l : ℤ, l < k → ¬ gonality_leq G l +def gonalityGeq (G : CFGraph) (k : ℤ) : Prop := + ∀ l : ℤ, l < k → ¬ gonalityLeq G l /-- A connected graph has gonality at most $g+1$, where $g$ is its genus. -/ theorem gonality_leq_genus_add_one - {G : CFGraph} (h_conn : graph_connected G) : gonality_leq G (genus G + 1) := by + {G : CFGraph} (h_conn : graphConnected G) : gonalityLeq G (genus G + 1) := by let q : G.V := Classical.arbitrary G.V - let D : CFDiv G := (genus G + 1) • one_chip q + let D : CFDiv G := (genus G + 1) • oneChip q have h_deg_D : deg D = genus G + 1 := by dsimp only [D] rw [map_zsmul, deg_one_chip, zsmul_one] simp only [Int.cast_add, Int.cast_eq, Int.cast_one] - have h_rank_geq : rank_geq G D 1 := by + have h_rank_geq : rankGeq G D 1 := by intro E hE - dsimp only [eff_of_degree, Set.mem_ofPred_eq] at hE + dsimp only [effOfDegree, Set.mem_ofPred_eq] at hE rcases hE with ⟨hE_eff, hE_deg⟩ have h_deg_sub : deg (D - E) = genus G := by rw [deg.map_sub, h_deg_D, hE_deg] @@ -259,21 +246,21 @@ theorem gonality_leq_genus_add_one rw [h_deg_sub] refine ⟨D, (rank_geq_iff G D 1).mp h_rank_geq, h_deg_D⟩ -private theorem one_le_of_gonality_leq {G : CFGraph} {k : ℤ} (h_gon : gonality_leq G k) : 1 ≤ k := by +private theorem one_le_of_gonality_leq {G : CFGraph} {k : ℤ} (h_gon : gonalityLeq G k) : 1 ≤ k := by rcases h_gon with ⟨D, h_rank, h_deg⟩ - have h_rank_geq : rank_geq G D 1 := (rank_geq_iff G D 1).mpr h_rank + have h_rank_geq : rankGeq G D 1 := (rank_geq_iff G D 1).mpr h_rank have h_deg_lower : (1 : ℤ) ≤ deg D := rank_le_degree G D 1 (by norm_num) h_rank_geq simpa only [ge_iff_le, h_deg] using h_deg_lower /-- The *(divisorial) gonality* of a connected graph is the smallest degree of a divisor of rank at least one. -/ -noncomputable def gonality {G : CFGraph} (_h_conn : graph_connected G) : ℤ := - sInf {k : ℤ | gonality_leq G k} +noncomputable def gonality {G : CFGraph} (_h_conn : graphConnected G) : ℤ := + sInf {k : ℤ | gonalityLeq G k} /-- A connected graph has gonality at most $g+1$, where $g$ is its genus. -/ -private lemma gonality_le_genus_add_one {G : CFGraph} (h_conn : graph_connected G) : +private lemma gonality_le_genus_add_one {G : CFGraph} (h_conn : graphConnected G) : gonality h_conn ≤ genus G + 1 := by - let S : Set ℤ := {k : ℤ | gonality_leq G k} + let S : Set ℤ := {k : ℤ | gonalityLeq G k} have h_bdd : BddBelow S := by refine ⟨1, ?_⟩ intro k hk @@ -282,8 +269,8 @@ private lemma gonality_le_genus_add_one {G : CFGraph} (h_conn : graph_connected exact csInf_le h_bdd (gonality_leq_genus_add_one h_conn) /-- The gonality of a connected graph is at least $1$. -/ -private lemma gonality_ge_one {G : CFGraph} (h_conn : graph_connected G) : 1 ≤ gonality h_conn := by - let S : Set ℤ := {k : ℤ | gonality_leq G k} +private lemma gonality_ge_one {G : CFGraph} (h_conn : graphConnected G) : 1 ≤ gonality h_conn := by + let S : Set ℤ := {k : ℤ | gonalityLeq G k} have h_nonempty : S.Nonempty := by refine ⟨genus G + 1, ?_⟩ exact gonality_leq_genus_add_one h_conn @@ -292,10 +279,10 @@ private lemma gonality_ge_one {G : CFGraph} (h_conn : graph_connected G) : 1 ≤ intro k hk exact one_le_of_gonality_leq hk -/-- The relation `gonality_geq G k` is equivalent to the inequality `gonality h_conn ≥ k`. -/ -@[simp] theorem gonality_geq_iff {G : CFGraph} (h_conn : graph_connected G) (k : ℤ) : - gonality_geq G k ↔ gonality h_conn ≥ k := by - let S : Set ℤ := {l : ℤ | gonality_leq G l} +/-- The relation `gonalityGeq G k` is equivalent to the inequality `gonality h_conn ≥ k`. -/ +@[simp] theorem gonality_geq_iff {G : CFGraph} (h_conn : graphConnected G) (k : ℤ) : + gonalityGeq G k ↔ gonality h_conn ≥ k := by + let S : Set ℤ := {l : ℤ | gonalityLeq G l} have h_nonempty : S.Nonempty := by refine ⟨genus G + 1, ?_⟩ exact gonality_leq_genus_add_one h_conn @@ -334,8 +321,8 @@ Conjecture 3.10(2). This is proved by Cools-Draisma-Payne-Robeva in and via a different construction by Hendrey in [Sparse graphs of high gonality](https://doi.org/10.1137/16M1095329). We are not aware of a formalization of this result. -/ -def max_gonality_existence (g : ℕ) : Prop := - ∃ (G : CFGraph.{u}) (h_conn : graph_connected G) (_g_eq : genus G = g), +def maxGonalityExistence (g : ℕ) : Prop := + ∃ (G : CFGraph.{u}) (h_conn : graphConnected G) (_g_eq : genus G = g), gonality h_conn = (g + 3) / 2 /-- The statement that in a given genus $g$, there exists a Brill-Noether general graph: @@ -355,9 +342,9 @@ This is a slightly strengthened form of a conjecture posed in M. Baker, namely Conjecture 3.9(2). It was proved by Cools-Draisma-Payne-Robeva in [A tropical proof of the Brill-Noether theorem](https://doi.org/10.1016/j.aim.2012.02.019), but we are not aware of a formalization of this result. -/ -def brill_noether_general_existence (g : ℤ) : Prop := - ∃ (G : CFGraph.{u}) (_h_conn : graph_connected G) (_g_eq : genus G = g), - ∀ (D : CFDiv G), (rank G D + 1) * (rank G (canonical_divisor G - D) + 1) ≤ g +def brillNoetherGeneralExistence (g : ℤ) : Prop := + ∃ (G : CFGraph.{u}) (_h_conn : graphConnected G) (_g_eq : genus G = g), + ∀ (D : CFDiv G), (rank G D + 1) * (rank G (canonicalDivisor G - D) + 1) ≤ g /-- The gonality conjecture for finite graphs: every connected graph of genus $g$ has gonality at most $\lfloor (g+3)/2 \rfloor$. @@ -365,7 +352,7 @@ at most $\lfloor (g+3)/2 \rfloor$. This is an open problem, posed by Baker in [Specialization of linear systems from curves to graphs](https://doi.org/10.2140/ant.2008.2.613), Conjecture 3.10(1). -/ -def gonality_conjecture {G : CFGraph} (h_conn : graph_connected G) : Prop := +def gonalityConjecture {G : CFGraph} (h_conn : graphConnected G) : Prop := gonality h_conn ≤ (genus G + 3) / 2 /-- The Brill-Noether conjecture for finite graphs: for every connected graph of genus $g$ @@ -378,7 +365,7 @@ there exists a divisor of degree $d$ and rank at least $r$. This is an open problem, posed in slightly different form by Baker in [Specialization of linear systems from curves to graphs](https://doi.org/10.2140/ant.2008.2.613), Conjecture 3.9(1). -/ -def brill_noether_conjecture {G : CFGraph} (_h_conn : graph_connected G) (r d : ℤ) : Prop := +def brillNoetherConjecture {G : CFGraph} (_h_conn : graphConnected G) (r d : ℤ) : Prop := let g := genus G let ρ := g - (r + 1) * (g - d + r) 0 ≤ ρ → ∃ (D : CFDiv G), rank G D ≥ r ∧ deg D = d From 7e9f98cc34d68169368c3649f18a9609427637a3 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 19:20:58 +0000 Subject: [PATCH 3/9] Regenerate complete chip-firing root imports --- LeanPool.lean | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/LeanPool.lean b/LeanPool.lean index 64e12372ce..8d5dbe7bd1 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -444,6 +444,16 @@ import LeanPool.ChannelCapacity.KernelCompositionKullbackLeibler import LeanPool.ChannelCapacity.NonDegeneracy import LeanPool.ChannelCapacity.StrictConcavity import LeanPool.ChipFiring +import LeanPool.ChipFiring.ChipFiringWithLean +import LeanPool.ChipFiring.ChipFiringWithLean.Algorithms +import LeanPool.ChipFiring.ChipFiringWithLean.Basic +import LeanPool.ChipFiring.ChipFiringWithLean.CFGraphExample +import LeanPool.ChipFiring.ChipFiringWithLean.Config +import LeanPool.ChipFiring.ChipFiringWithLean.Orientation +import LeanPool.ChipFiring.ChipFiringWithLean.PalomarSolution +import LeanPool.ChipFiring.ChipFiringWithLean.RRGHelpers +import LeanPool.ChipFiring.ChipFiringWithLean.Rank +import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch import LeanPool.Chudnovsky import LeanPool.Chudnovsky.Basic import LeanPool.Chudnovsky.Chudnovsky From 7b122ee7f78dd3dc66ae8c43f47d7458b1501fad Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 19:37:57 +0000 Subject: [PATCH 4/9] Namespace chip-firing declarations for aggregate import compatibility --- LeanPool/ChipFiring.lean | 2 +- LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean | 4 ++++ LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean | 4 ++++ .../ChipFiring/ChipFiringWithLean/CFGraphExample.lean | 4 ++++ LeanPool/ChipFiring/ChipFiringWithLean/Config.lean | 4 ++++ LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean | 4 ++++ .../ChipFiring/ChipFiringWithLean/PalomarSolution.lean | 4 ++++ LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean | 4 ++++ LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean | 4 ++++ LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean | 4 ++++ LeanPool/projects.yml | 8 ++++---- 11 files changed, 41 insertions(+), 5 deletions(-) diff --git a/LeanPool/ChipFiring.lean b/LeanPool/ChipFiring.lean index 8e76c1346d..46a88c56f3 100644 --- a/LeanPool/ChipFiring.lean +++ b/LeanPool/ChipFiring.lean @@ -21,7 +21,7 @@ import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch Source: url:https://github.com/dhyeymavani2003/chip-firing-with-lean Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger Status: verified -Main declarations: `Propositions.riemann_roch`, `Propositions.clifford` +Main declarations: `ChipFiring.Propositions.riemann_roch`, `ChipFiring.Propositions.clifford` Tags: combinatorics MSC: 05C57, 14T20 -/ diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean index 0c2e103a5c..687e2a5871 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean @@ -18,6 +18,8 @@ In particular, the core mathematical statements about $q$-reduced divisors, supe and Dhar's algorithm are proved elsewhere in the library. -/ +namespace ChipFiring + namespace CF @@ -293,3 +295,5 @@ noncomputable def dharBurningSetWithOrientation (G : CFGraph) (q : G.V) (c : G.V dharBurningSetWithOrientationLoop G c initial_S initial_B initial_O (Fintype.card G.V + 1) end CF + +end ChipFiring diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean index a3e90a4be7..58b760dd95 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean @@ -24,6 +24,8 @@ Many main theorems in this library require connectivity; see `graphConnected`. I proof of connectivity must be provided as an additional argument. -/ +namespace ChipFiring + universe u @@ -1753,3 +1755,5 @@ theorem sum_vertex_degree_eq_twice_card_edges (G : CFGraph) : rw [sum_card_filter_eq_mul G G.edges (fun v e => e.fst = v ∨ e.snd = v) 2 (edge_incident_vertices_count G)] _ = 2 * ↑(Multiset.card G.edges) := by rw [Nat.cast_mul, Nat.cast_two] + +end ChipFiring diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean b/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean index 526b2fbbb2..1f1cf95db7 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean @@ -12,6 +12,8 @@ import Mathlib.LinearAlgebra.Matrix.Symmetric Chip firing, graph divisors, and their combinatorial properties. -/ +namespace ChipFiring + open Multiset Finset @@ -193,3 +195,5 @@ private theorem non_q_reduced_example_is_invalid : ¬qReduced exampleGraph Perso simpa only [nonQReducedExample, Int.reduceNeg, Int.neg_nonneg, Int.reduceLE] using h1' Person.B (by decide) } + +end ChipFiring diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean index 0e092249af..107123f0b1 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean @@ -23,6 +23,8 @@ The quantity `outdegS G S v` counts edges from $v$ to vertices outside $S$, and relevant threshold for the superstability condition. -/ +namespace ChipFiring + open Multiset Finset @@ -787,3 +789,5 @@ termination_by L.list.length decreasing_by rw [h,h'] simp only [List.length_cons, lt_add_iff_pos_right, Order.lt_one_iff] + +end ChipFiring diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean index 9ecd2523f8..3c6bd16cda 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean @@ -31,6 +31,8 @@ The main results are: See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 4.8. -/ +namespace ChipFiring + open Multiset Finset @@ -1248,3 +1250,5 @@ theorem orientation_superstable_bijection (G : CFGraph) (q : G.V) : exact h_config_eq_target -- Proof irrelevance handles the equality of the property components. } + +end ChipFiring diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean b/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean index c0ff50e2ec..a71c2f4e72 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean @@ -11,6 +11,8 @@ import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch Chip firing, graph divisors, and their combinatorial properties. -/ +namespace ChipFiring + namespace Propositions private lemma rank_eq_rank (G : CFGraph) (D : CFDiv G) (r : ℤ) @@ -43,3 +45,5 @@ theorem clifford {G : CFGraph} (h_conn : graphConnected G) (D : CFDiv G) : exact h_clifford end Propositions + +end ChipFiring diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean b/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean index 9630ecaede..fe0014fc88 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean @@ -20,6 +20,8 @@ maximal unwinnable divisors: - Every maximal unwinnable divisor has degree $g - 1$ (`maximal_unwinnable_deg`). -/ +namespace ChipFiring + open Multiset Finset @@ -540,3 +542,5 @@ theorem rank_degree_inequality simp only [_root_.map_add, map_sub] linarith linarith [degF, moderator_degree M_moderator] + +end ChipFiring diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean index 9527d6c3df..e2ad5dbfd7 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean @@ -26,6 +26,8 @@ A divisor $D$ is *maximal unwinnable* if it is unwinnable but $D + \delta_v$ is for every vertex $v$. Such divisors arise in the proof of the Riemann-Roch theorem. -/ +namespace ChipFiring + open Multiset Finset @@ -353,3 +355,5 @@ theorem one_le_apply_of_q_reduced_of_rank_geq_one {G : CFGraph} {q : G.V} have hq := heff q simp only [Pi.sub_apply, one_chip_apply_v] at hq omega + +end ChipFiring diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean b/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean index c68805e66a..8903f88c74 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean @@ -13,6 +13,8 @@ The Riemann-Roch theorem for graphs and its main corollaries. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Chapter 5. -/ +namespace ChipFiring + universe u @@ -369,3 +371,5 @@ def brillNoetherConjecture {G : CFGraph} (_h_conn : graphConnected G) (r d : ℤ let g := genus G let ρ := g - (r + 1) * (g - d + r) 0 ≤ ρ → ∃ (D : CFDiv G), rank G D ≥ r ∧ deg D = d + +end ChipFiring diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index dc3db86e60..b50fa64eaf 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -9987,13 +9987,13 @@ projects: license: Apache-2.0 status: verified main_declarations: - - Propositions.riemann_roch - - Propositions.clifford + - ChipFiring.Propositions.riemann_roch + - ChipFiring.Propositions.clifford main_results: - - declaration: Propositions.riemann_roch + - declaration: ChipFiring.Propositions.riemann_roch informal: For a finite connected graph, the ranks of a divisor and its canonical complement satisfy the graph Riemann–Roch formula. - - declaration: Propositions.clifford + - declaration: ChipFiring.Propositions.clifford informal: For a special divisor on a finite connected graph, its rank is at most half its degree. tags: From 7d32440a1b8fc30df75025bd137466d358ad5930 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 08:22:41 +0000 Subject: [PATCH 5/9] Migrate chip-firing formalization to the Lean module system --- LeanPool/ChipFiring.lean | 25 +++++++++++-------- LeanPool/ChipFiring/ChipFiringWithLean.lean | 21 ++++++++++------ .../ChipFiringWithLean/Algorithms.lean | 13 +++++++--- .../ChipFiring/ChipFiringWithLean/Basic.lean | 13 +++++++--- .../ChipFiringWithLean/CFGraphExample.lean | 9 +++++-- .../ChipFiring/ChipFiringWithLean/Config.lean | 7 +++++- .../ChipFiringWithLean/Orientation.lean | 9 +++++-- .../ChipFiringWithLean/PalomarSolution.lean | 7 +++++- .../ChipFiringWithLean/RRGHelpers.lean | 11 +++++--- .../ChipFiring/ChipFiringWithLean/Rank.lean | 7 +++++- .../ChipFiringWithLean/RiemannRoch.lean | 7 +++++- 11 files changed, 92 insertions(+), 37 deletions(-) diff --git a/LeanPool/ChipFiring.lean b/LeanPool/ChipFiring.lean index 46a88c56f3..3d53d9fde7 100644 --- a/LeanPool/ChipFiring.lean +++ b/LeanPool/ChipFiring.lean @@ -4,16 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ -import LeanPool.ChipFiring.ChipFiringWithLean -import LeanPool.ChipFiring.ChipFiringWithLean.Algorithms -import LeanPool.ChipFiring.ChipFiringWithLean.Basic -import LeanPool.ChipFiring.ChipFiringWithLean.CFGraphExample -import LeanPool.ChipFiring.ChipFiringWithLean.Config -import LeanPool.ChipFiring.ChipFiringWithLean.Orientation -import LeanPool.ChipFiring.ChipFiringWithLean.PalomarSolution -import LeanPool.ChipFiring.ChipFiringWithLean.RRGHelpers -import LeanPool.ChipFiring.ChipFiringWithLean.Rank -import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch +module + +public import LeanPool.ChipFiring.ChipFiringWithLean +public import LeanPool.ChipFiring.ChipFiringWithLean.Algorithms +public import LeanPool.ChipFiring.ChipFiringWithLean.Basic +public import LeanPool.ChipFiring.ChipFiringWithLean.CFGraphExample +public import LeanPool.ChipFiring.ChipFiringWithLean.Config +public import LeanPool.ChipFiring.ChipFiringWithLean.Orientation +public import LeanPool.ChipFiring.ChipFiringWithLean.PalomarSolution +public import LeanPool.ChipFiring.ChipFiringWithLean.RRGHelpers +public import LeanPool.ChipFiring.ChipFiringWithLean.Rank +public import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch + /-! # Chip-Firing with Lean 4 @@ -25,3 +28,5 @@ Main declarations: `ChipFiring.Propositions.riemann_roch`, `ChipFiring.Propositi Tags: combinatorics MSC: 05C57, 14T20 -/ + +@[expose] public section diff --git a/LeanPool/ChipFiring/ChipFiringWithLean.lean b/LeanPool/ChipFiring/ChipFiringWithLean.lean index a4432e9446..92be5d9004 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean.lean @@ -5,17 +5,22 @@ Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ -- This module serves as the root of the `ChipFiringWithLean` library. -- Import modules here that should be built as part of the library. -import LeanPool.ChipFiring.ChipFiringWithLean.Basic -import LeanPool.ChipFiring.ChipFiringWithLean.CFGraphExample -import LeanPool.ChipFiring.ChipFiringWithLean.Config -import LeanPool.ChipFiring.ChipFiringWithLean.Orientation -import LeanPool.ChipFiring.ChipFiringWithLean.Algorithms -import LeanPool.ChipFiring.ChipFiringWithLean.Rank -import LeanPool.ChipFiring.ChipFiringWithLean.RRGHelpers -import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch +module + +public import LeanPool.ChipFiring.ChipFiringWithLean.Basic +public import LeanPool.ChipFiring.ChipFiringWithLean.CFGraphExample +public import LeanPool.ChipFiring.ChipFiringWithLean.Config +public import LeanPool.ChipFiring.ChipFiringWithLean.Orientation +public import LeanPool.ChipFiring.ChipFiringWithLean.Algorithms +public import LeanPool.ChipFiring.ChipFiringWithLean.Rank +public import LeanPool.ChipFiring.ChipFiringWithLean.RRGHelpers +public import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch + /-! # ChipFiringWithLean Chip firing, graph divisors, and their combinatorial properties. -/ + +@[expose] public section diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean index 687e2a5871..02190f698b 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean @@ -3,7 +3,10 @@ Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights res Released under Apache 2.0 license as described in the file LICENSE. Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ -import LeanPool.ChipFiring.ChipFiringWithLean.Orientation +module + +public import LeanPool.ChipFiring.ChipFiringWithLean.Orientation + /-! ## Experimental computational algorithms for chip-firing @@ -18,6 +21,8 @@ In particular, the core mathematical statements about $q$-reduced divisors, supe and Dhar's algorithm are proved elsewhere in the library. -/ +@[expose] public section + namespace ChipFiring @@ -32,15 +37,15 @@ open Finset BigOperators List def isEffective (D : CFDiv G) : Bool := decide (∀ v, D v ≥ 0) /-- A small size measure used only to set conservative default loop fuel. -/ -private def divisorMagnitude (G : CFGraph) (D : CFDiv G) : Nat := +def divisorMagnitude (G : CFGraph) (D : CFDiv G) : Nat := ∑ v : G.V, Int.natAbs (D v) /-- Default fuel for greedy routines, scaled by the actual chip counts in the input. -/ -private def greedyFuel (G : CFGraph) (D : CFDiv G) : Nat := +def greedyFuel (G : CFGraph) (D : CFDiv G) : Nat := (Fintype.card G.V + 1) * (divisorMagnitude G D + 1) ^ 2 + 1 /-- Number of chips away from the source, used for the q-reduction loop budget. -/ -private def nonSourceChipCount (G : CFGraph) (q : G.V) (D : CFDiv G) : Nat := +def nonSourceChipCount (G : CFGraph) (q : G.V) (D : CFDiv G) : Nat := ∑ v ∈ Finset.univ.erase q, Int.toNat (D v) /-- Fuel-bounded greedy borrowing loop, recording vertices visited and the accumulated diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean index 58b760dd95..e17e74324d 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean @@ -3,10 +3,13 @@ Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights res Released under Apache 2.0 license as described in the file LICENSE. Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ -import Mathlib.Algebra.CharP.Defs -import Mathlib.Algebra.Group.Subgroup.Finite -import Mathlib.Analysis.Normed.Ring.Lemmas -import Mathlib.Data.Matrix.Mul +module + +public import Mathlib.Algebra.CharP.Defs +public import Mathlib.Algebra.Group.Subgroup.Finite +public import Mathlib.Analysis.Normed.Ring.Lemmas +public import Mathlib.Data.Matrix.Mul + /-! ## Chip-firing graphs @@ -24,6 +27,8 @@ Many main theorems in this library require connectivity; see `graphConnected`. I proof of connectivity must be provided as an additional argument. -/ +@[expose] public section + namespace ChipFiring diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean b/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean index 1f1cf95db7..5199b9e58c 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/CFGraphExample.lean @@ -3,8 +3,11 @@ Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights res Released under Apache 2.0 license as described in the file LICENSE. Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ -import LeanPool.ChipFiring.ChipFiringWithLean.Basic -import Mathlib.LinearAlgebra.Matrix.Symmetric +module + +public import LeanPool.ChipFiring.ChipFiringWithLean.Basic +public import Mathlib.LinearAlgebra.Matrix.Symmetric + /-! # CFGraphExample @@ -12,6 +15,8 @@ import Mathlib.LinearAlgebra.Matrix.Symmetric Chip firing, graph divisors, and their combinatorial properties. -/ +@[expose] public section + namespace ChipFiring diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean index 107123f0b1..a8728991cc 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean @@ -3,7 +3,10 @@ Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights res Released under Apache 2.0 license as described in the file LICENSE. Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ -import LeanPool.ChipFiring.ChipFiringWithLean.Basic +module + +public import LeanPool.ChipFiring.ChipFiringWithLean.Basic + /-! ## Configurations and superstable configurations @@ -23,6 +26,8 @@ The quantity `outdegS G S v` counts edges from $v$ to vertices outside $S$, and relevant threshold for the superstability condition. -/ +@[expose] public section + namespace ChipFiring diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean index 3c6bd16cda..aa5b702ec1 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean @@ -3,8 +3,11 @@ Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights res Released under Apache 2.0 license as described in the file LICENSE. Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ -import LeanPool.ChipFiring.ChipFiringWithLean.Config -import Mathlib.Data.DFinsupp.Multiset +module + +public import LeanPool.ChipFiring.ChipFiringWithLean.Config +public import Mathlib.Data.DFinsupp.Multiset + /-! ## Orientations of chip-firing graphs @@ -31,6 +34,8 @@ The main results are: See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 4.8. -/ +@[expose] public section + namespace ChipFiring diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean b/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean index a71c2f4e72..700bed2695 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/PalomarSolution.lean @@ -3,7 +3,10 @@ Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights res Released under Apache 2.0 license as described in the file LICENSE. Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ -import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch +module + +public import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch + /-! # PalomarSolution @@ -11,6 +14,8 @@ import LeanPool.ChipFiring.ChipFiringWithLean.RiemannRoch Chip firing, graph divisors, and their combinatorial properties. -/ +@[expose] public section + namespace ChipFiring namespace Propositions diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean b/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean index fe0014fc88..9ccfc4be16 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean @@ -3,8 +3,11 @@ Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights res Released under Apache 2.0 license as described in the file LICENSE. Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ -import LeanPool.ChipFiring.ChipFiringWithLean.Orientation -import LeanPool.ChipFiring.ChipFiringWithLean.Rank +module + +public import LeanPool.ChipFiring.ChipFiringWithLean.Orientation +public import LeanPool.ChipFiring.ChipFiringWithLean.Rank + /-! ## Maximal superstable configurations and maximal unwinnable divisors @@ -20,6 +23,8 @@ maximal unwinnable divisors: - Every maximal unwinnable divisor has degree $g - 1$ (`maximal_unwinnable_deg`). -/ +@[expose] public section + namespace ChipFiring @@ -42,7 +47,7 @@ private lemma qReducedRep_spec {G : CFGraph} zeroing out the chips at $q$. -/ noncomputable def qReducedConfig {G : CFGraph} (h_conn : graphConnected G) (q : G.V) (D : CFDiv G) : Config G q := - toConfig ⟨qReducedRep h_conn q D, (qReducedRep_spec h_conn q D).2.1⟩ + toConfig ⟨qReducedRep h_conn q D, (by exact (qReducedRep_spec h_conn q D).2.1)⟩ /-- The canonical configuration attached to $D$ is superstable. -/ private lemma qReducedConfig_superstable {G : CFGraph} diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean index e2ad5dbfd7..e0c5be7c81 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Rank.lean @@ -3,7 +3,10 @@ Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights res Released under Apache 2.0 license as described in the file LICENSE. Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ -import LeanPool.ChipFiring.ChipFiringWithLean.Basic +module + +public import LeanPool.ChipFiring.ChipFiringWithLean.Basic + /-! ## The rank function @@ -26,6 +29,8 @@ A divisor $D$ is *maximal unwinnable* if it is unwinnable but $D + \delta_v$ is for every vertex $v$. Such divisors arise in the proof of the Riemann-Roch theorem. -/ +@[expose] public section + namespace ChipFiring diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean b/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean index 8903f88c74..4c36981376 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/RiemannRoch.lean @@ -3,7 +3,10 @@ Copyright (c) 2026 Dhyey Dharmendrakumar Mavani, Nathan Pflueger. All rights res Released under Apache 2.0 license as described in the file LICENSE. Authors: Dhyey Dharmendrakumar Mavani, Nathan Pflueger -/ -import LeanPool.ChipFiring.ChipFiringWithLean.RRGHelpers +module + +public import LeanPool.ChipFiring.ChipFiringWithLean.RRGHelpers + /-! # Riemann-Roch for graphs @@ -13,6 +16,8 @@ The Riemann-Roch theorem for graphs and its main corollaries. See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Chapter 5. -/ +@[expose] public section + namespace ChipFiring From b8c44faaebffc40595a258ec2aae80c9b356a00e Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 18:46:26 +0000 Subject: [PATCH 6/9] fix: propagate chip-firing reduction fuel exhaustion --- .../ChipFiringWithLean/Algorithms.lean | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean index 02190f698b..dbee75dbb6 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean @@ -167,14 +167,12 @@ noncomputable def makeNonNegativeExceptQ (G : CFGraph) (q : G.V) (D : CFDiv G) ( : Option (CFDiv G) := makeNonNegativeExceptQLoop G q D max_fuel -/-- Fuel-bounded reduction loop that fires the nonburning set and returns the current -divisor. -/ +/-- Fuel-bounded reduction loop that fires the nonburning set. +Returns `none` if the fuel runs out before reduction completes. -/ noncomputable def findQReducedDivisorLoop (G : CFGraph) (q : G.V) (current_D : CFDiv G) (fuel : - Nat) : CFDiv G := - if h_fuel_zero : fuel = 0 then -- Name hypothesis - -- Fuel exhausted in main findQReducedDivisorLoop G q, return current state (might not - -- be fully q-reduced) - current_D + Nat) : Option (CFDiv G) := + if h_fuel_zero : fuel = 0 then + none else -- Use current_D as the configuration function for dharBurningSet let S := dharBurningSet G q current_D @@ -183,7 +181,7 @@ noncomputable def findQReducedDivisorLoop (G : CFGraph) (q : G.V) (current_D : C findQReducedDivisorLoop G q (fireSet G current_D S) (fuel - 1) else -- S is empty, the divisor is q-reduced - current_D + some current_D termination_by fuel decreasing_by simp_wf; exact Nat.pos_of_ne_zero h_fuel_zero -- Simpler explicit proof @@ -197,7 +195,7 @@ It then repeatedly finds the maximal legal firing set $S \subseteq V(G) \setminus \{q\}$ using `dharBurningSet`, and fires $S$ until `dharBurningSet` returns the empty set. -Returns `none` if preprocessing fails (fuel exhaustion or insufficient degree). +Returns `none` if preprocessing or reduction exhausts its fuel. -/ @[simp] noncomputable def findQReducedDivisor (G : CFGraph) (q : G.V) (D : CFDiv G) : Option (CFDiv G) := @@ -210,7 +208,7 @@ noncomputable def findQReducedDivisor (G : CFGraph) (q : G.V) (D : CFDiv G) : Op -- Estimate fuel for main findQReducedDivisorLoop G q from possible -- q-effective non-source chip vectors. let main_loop_fuel := (nonSourceChipCount G q D_preprocessed + 1) ^ Fintype.card G.V + 1 - some (findQReducedDivisorLoop G q D_preprocessed main_loop_fuel) + findQReducedDivisorLoop G q D_preprocessed main_loop_fuel /-- Simulates the fire spread from $q$ in Dhar's algorithm on a configuration $c$. From 9b476e61e7e8d2cbb7f375af94f35dad77b7a62f Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 07:28:58 +0000 Subject: [PATCH 7/9] fix(ChipFiring): distinguish inconclusive winnability searches --- .../ChipFiringWithLean/Algorithms.lean | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean index dbee75dbb6..01452e1995 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean @@ -227,17 +227,17 @@ noncomputable def dhar (G : CFGraph) (D : CFDiv G) (v : G.V) : Option (CFDiv G) findQReducedDivisor G v D /-- -The efficient winnability determination algorithm. +Attempts to determine winnability with a fuel-bounded reduction. -This checks whether $D$ is winnable by finding the $q$-reduced representative $D_q$ -and checking whether $D_q(q) \ge 0$ (see Corry-Perkinson, Corollary 3.7). It requires -a chosen source vertex $q$ and returns `false` if the reduction process fails. +An already effective divisor returns `some true`, including on disconnected graphs. +Otherwise this seeks the $q$-reduced representative $D_q$ and returns +`some (D_q(q) ≥ 0)` (see Corry-Perkinson, Corollary 3.7). +If reduction exhausts its fuel, `none` records an inconclusive search, not unwinnability. -/ @[simp] -noncomputable def isWinnable (G : CFGraph) (q : G.V) (D : CFDiv G) : Bool := - match findQReducedDivisor G q D with - | none => false -- Reduction process failed (preprocessing or main loop fuel) - | some D_q => D_q q >= 0 +noncomputable def isWinnable (G : CFGraph) (q : G.V) (D : CFDiv G) : Option Bool := + if isEffective D then some true + else (findQReducedDivisor G q D).map (fun D_q => decide (D_q q ≥ 0)) /-- Calculates the incoming burning degree of a vertex $v$ from a set $B$. From 59f6499ee374a945e7a58f4b072a2f3017b2b569 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 27 Sep 2026 14:42:01 +0000 Subject: [PATCH 8/9] Generalize chip-firing orientation and divisor helpers --- LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean | 6 +++--- LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean | 9 ++++----- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean index aa5b702ec1..01ffc2d0a0 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Orientation.lean @@ -489,10 +489,10 @@ lemma config_and_divisor_from_O {G : CFGraph} (O : CFOrientation G) {q : G.V} See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Lemma 4.3. -/ lemma orientation_determined_by_indegrees {G : CFGraph} (O O' : CFOrientation G) : - isAcyclic G O → isAcyclic G O' → + isAcyclic G O → (∀ v : G.V, indeg G O v = indeg G O' v) → O = O' := by - intro h_acyc h_acyc' h_indeg_eq + intro h_acyc h_indeg_eq let S := { e : G.V × G.V | O.directedEdges.count e > O'.directedEdges.count e } have suff_S_empty : S = ∅ → O = O' := by intro h_S_empty @@ -592,7 +592,7 @@ private theorem config_to_orientation_unique (G : CFGraph) (q : G.V) (h_eq₁ : orientationToConfig G O₁ q hO₁ = c) (h_eq₂ : orientationToConfig G O₂ q hO₂ = c) : O₁ = O₂ := by - apply orientation_determined_by_indegrees O₁ O₂ hO₁.1 hO₂.1 + apply orientation_determined_by_indegrees O₁ O₂ hO₁.1 intro v have h_deg₁ := orientation_to_config_indeg G O₁ q hO₁ v have h_deg₂ := orientation_to_config_indeg G O₂ q hO₂ v diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean b/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean index 9ccfc4be16..1cd08d0f7c 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean @@ -72,14 +72,13 @@ lemma superstable_of_divisor {G : CFGraph} (h_conn : graphConnected G) (q : G.V) exact h · simpa only using qReducedConfig_superstable h_conn q D -/-- If $D$ is unwinnable and $D \sim c + k \cdot q$ for a superstable $c$, then $k < 0$. -/ +/-- If $D$ is unwinnable and $D \sim c + k \cdot q$ for a configuration $c$, then $k < 0$. -/ lemma superstable_of_divisor_negative_k (G : CFGraph) (q : G.V) (D : CFDiv G) : ¬(winnable G D) → ∀ (c : Config G q) (k : ℤ), linearEquiv G D (c.chips + k • (oneChip q)) → - superstable G q c → k < 0 := by - intro h_not_winnable c k h_equiv h_super + intro h_not_winnable c k h_equiv contrapose! h_not_winnable with k_nonneg let D' := c.chips + k • (oneChip q) have D'_eff : effective D' := by @@ -395,7 +394,7 @@ theorem acyclic_orientation_maximal_unwinnable_correspondence_and_degree rw [hv, h₁, h₂] · simp only [hv, ↓reduceIte, tsub_zero] at this exact this - exact Subtype.ext (orientation_determined_by_indegrees O₁.val O₂.val O₁.prop.1 O₂.prop.1 + exact Subtype.ext (orientation_determined_by_indegrees O₁.val O₂.val O₁.prop.1 h_indeg) } { -- Part 2: Degree characterization @@ -447,7 +446,7 @@ lemma moderator_of_unwinnable {G : CFGraph} (h_conn : graphConnected G) (D : CFD ∃ (M H : CFDiv G), isModerator M ∧ effective H ∧ linearEquiv G M (D+H) := by let q := Classical.arbitrary G.V rcases superstable_of_divisor h_conn q D with ⟨c, k, h_equiv, h_super⟩ - have h_k_neg : k < 0 := superstable_of_divisor_negative_k G q D unwin c k h_equiv h_super + have h_k_neg : k < 0 := superstable_of_divisor_negative_k G q D unwin c k h_equiv rcases maximal_superstable_exists G q c h_super with ⟨c', h_max', h_ge⟩ rcases maximal_superstable_orientation G q c' h_max' with ⟨O, hO, h_orient_eq_c'⟩ let H : CFDiv G := -(k+1) • (oneChip q) + c'.chips - c.chips From 75521d6a2edbb544e3c9d1bae304a711f33e36fa Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 27 Sep 2026 17:36:37 +0000 Subject: [PATCH 9/9] Identify the verified edition for chip-firing citations --- .../ChipFiring/ChipFiringWithLean/Algorithms.lean | 3 ++- LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean | 12 ++++++++---- LeanPool/ChipFiring/ChipFiringWithLean/Config.lean | 6 ++++-- .../ChipFiring/ChipFiringWithLean/RRGHelpers.lean | 3 ++- 4 files changed, 16 insertions(+), 8 deletions(-) diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean index 01452e1995..e6f0b7b125 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Algorithms.lean @@ -231,7 +231,8 @@ Attempts to determine winnability with a fuel-bounded reduction. An already effective divisor returns `some true`, including on disconnected graphs. Otherwise this seeks the $q$-reduced representative $D_q$ and returns -`some (D_q(q) ≥ 0)` (see Corry-Perkinson, Corollary 3.7). +`some (D_q(q) ≥ 0)` (see [Corry-Perkinson, preliminary version]( +https://people.reed.edu/~davidp/divisors_and_sandpiles/mbk_draft.pdf#page=57), Corollary 3.8). If reduction exhausts its fuel, `none` records an inconclusive search, not unwinnability. -/ @[simp] diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean index e17e74324d..bfde63b6f9 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Basic.lean @@ -1258,7 +1258,8 @@ lemma effective_of_winnable_and_q_reduced (G : CFGraph) (q : G.V) (D : CFDiv G) /-- The $q$-reduced representative of a divisor class is unique. -See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 3.6, +See: [Corry-Perkinson, preliminary version]( +https://people.reed.edu/~davidp/divisors_and_sandpiles/mbk_draft.pdf#page=57), Theorem 3.7, part 2 (uniqueness). -/ theorem q_reduced_unique (G : CFGraph) (q : G.V) (D₁ D₂ : CFDiv G) : qReduced G q D₁ ∧ qReduced G q D₂ ∧ linearEquiv G D₁ D₂ → D₁ = D₂ := by @@ -1553,7 +1554,8 @@ decreasing_by /-- Every divisor is linearly equivalent to some $q$-reduced divisor. -See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 3.6, +See: [Corry-Perkinson, preliminary version]( +https://people.reed.edu/~davidp/divisors_and_sandpiles/mbk_draft.pdf#page=57), Theorem 3.7, part 1 (existence). -/ theorem exists_q_reduced_representative {G : CFGraph} (h_conn : graphConnected G) (q : G.V) (D : CFDiv G) : @@ -1570,7 +1572,8 @@ by /-- Every divisor is linearly equivalent to exactly one $q$-reduced divisor. -See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Theorem 3.6 +See: [Corry-Perkinson, preliminary version]( +https://people.reed.edu/~davidp/divisors_and_sandpiles/mbk_draft.pdf#page=57), Theorem 3.7 (existence and uniqueness combined). -/ lemma unique_q_reduced {G : CFGraph} (h_conn : graphConnected G) (q : G.V) (D : CFDiv G) : ∃! D' : CFDiv G, linearEquiv G D D' ∧ qReduced G q D' := by @@ -1584,7 +1587,8 @@ lemma unique_q_reduced {G : CFGraph} (h_conn : graphConnected G) (q : G.V) (D : /-- A divisor is winnable if and only if its $q$-reduced representative is effective. -See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Corollary 3.7, +See: [Corry-Perkinson, preliminary version]( +https://people.reed.edu/~davidp/divisors_and_sandpiles/mbk_draft.pdf#page=57), Corollary 3.8, rephrased. -/ theorem winnable_iff_q_reduced_effective {G : CFGraph} (h_conn : graphConnected G) (q : G.V) (D : CFDiv G) : diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean b/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean index a8728991cc..ea42e1259d 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/Config.lean @@ -310,7 +310,8 @@ lemma config_eq_of_le_and_degree {q : G.V} {c1 c2 : Config G q} (h_le : c2 ≤ c $S \subseteq V(G) \setminus \{q\}$, some vertex in $S$ has fewer chips than its out-degree to $V(G) \setminus S$. -See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Definition 3.12. -/ +See: [Corry-Perkinson, preliminary version]( +https://people.reed.edu/~davidp/divisors_and_sandpiles/mbk_draft.pdf#page=59), Definition 3.13. -/ def superstable (G : CFGraph) (q : G.V) (c : Config G q) : Prop := ∀ S ⊆ Vtilde q, S.Nonempty → ∃ v ∈ S, c.chips v < outdegS G S v @@ -318,7 +319,8 @@ def superstable (G : CFGraph) (q : G.V) (c : Config G q) : Prop := /-- A configuration $c$ is superstable if and only if `toDiv d c` is $q$-reduced, for any prescribed degree $d$. -See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Remark 3.14. -/ +See: [Corry-Perkinson, preliminary version]( +https://people.reed.edu/~davidp/divisors_and_sandpiles/mbk_draft.pdf#page=59), Remark 3.15. -/ lemma superstable_iff_q_reduced (G : CFGraph) (q : G.V) (d : ℤ) (c : Config G q) : superstable G q c ↔ qReduced G q (toDiv d c) := by dsimp only [superstable, ne_eq] diff --git a/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean b/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean index 1cd08d0f7c..33a4732347 100644 --- a/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean +++ b/LeanPool/ChipFiring/ChipFiringWithLean/RRGHelpers.lean @@ -58,7 +58,8 @@ private lemma qReducedConfig_superstable {G : CFGraph} /-- Every divisor $D$ is linearly equivalent to $c+kq$ for some superstable configuration $c$ and integer $k$. -See: [Corry-Perkinson](https://pubs.ams.org/ebooks/mbk/114), Remark 3.14. -/ +See: [Corry-Perkinson, preliminary version]( +https://people.reed.edu/~davidp/divisors_and_sandpiles/mbk_draft.pdf#page=59), Remark 3.15. -/ lemma superstable_of_divisor {G : CFGraph} (h_conn : graphConnected G) (q : G.V) (D : CFDiv G) : ∃ (c : Config G q) (k : ℤ), linearEquiv G D (c.chips + k • (oneChip q)) ∧