From 5c440b1826a04391243e9b7d5f7ea183021eb18b Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 20 Oct 2026 10:15:34 +0000 Subject: [PATCH 1/5] Import sharp Graham scheduling bounds and equality cases --- LeanPool/GrahamLPT.lean | 67 +++ LeanPool/GrahamLPT/Basic.lean | 313 ++++++++++++++ LeanPool/GrahamLPT/Certificates.lean | 275 ++++++++++++ LeanPool/GrahamLPT/CoffmanSethi.lean | 422 ++++++++++++++++++ LeanPool/GrahamLPT/Contracts.lean | 255 +++++++++++ LeanPool/GrahamLPT/Counter.lean | 204 +++++++++ LeanPool/GrahamLPT/Defs.lean | 92 ++++ LeanPool/GrahamLPT/Equality.lean | 626 +++++++++++++++++++++++++++ LeanPool/GrahamLPT/FixedCount.lean | 381 ++++++++++++++++ LeanPool/GrahamLPT/GrahamScaled.lean | 138 ++++++ LeanPool/GrahamLPT/Imports.lean | 27 ++ LeanPool/GrahamLPT/Key.lean | 211 +++++++++ LeanPool/GrahamLPT/LPTBound.lean | 86 ++++ LeanPool/GrahamLPT/LPTForm.lean | 85 ++++ LeanPool/GrahamLPT/ListBound.lean | 75 ++++ LeanPool/GrahamLPT/ListOptimum.lean | 228 ++++++++++ LeanPool/GrahamLPT/OptList.lean | 228 ++++++++++ LeanPool/GrahamLPT/Ratio.lean | 74 ++++ LeanPool/GrahamLPT/TightLPT.lean | 281 ++++++++++++ LeanPool/GrahamLPT/TightList.lean | 223 ++++++++++ LeanPool/projects/graham-lpt.yaml | 57 +++ 21 files changed, 4348 insertions(+) create mode 100644 LeanPool/GrahamLPT.lean create mode 100644 LeanPool/GrahamLPT/Basic.lean create mode 100644 LeanPool/GrahamLPT/Certificates.lean create mode 100644 LeanPool/GrahamLPT/CoffmanSethi.lean create mode 100644 LeanPool/GrahamLPT/Contracts.lean create mode 100644 LeanPool/GrahamLPT/Counter.lean create mode 100644 LeanPool/GrahamLPT/Defs.lean create mode 100644 LeanPool/GrahamLPT/Equality.lean create mode 100644 LeanPool/GrahamLPT/FixedCount.lean create mode 100644 LeanPool/GrahamLPT/GrahamScaled.lean create mode 100644 LeanPool/GrahamLPT/Imports.lean create mode 100644 LeanPool/GrahamLPT/Key.lean create mode 100644 LeanPool/GrahamLPT/LPTBound.lean create mode 100644 LeanPool/GrahamLPT/LPTForm.lean create mode 100644 LeanPool/GrahamLPT/ListBound.lean create mode 100644 LeanPool/GrahamLPT/ListOptimum.lean create mode 100644 LeanPool/GrahamLPT/OptList.lean create mode 100644 LeanPool/GrahamLPT/Ratio.lean create mode 100644 LeanPool/GrahamLPT/TightLPT.lean create mode 100644 LeanPool/GrahamLPT/TightList.lean create mode 100644 LeanPool/projects/graham-lpt.yaml diff --git a/LeanPool/GrahamLPT.lean b/LeanPool/GrahamLPT.lean new file mode 100644 index 0000000000..c49c60dfd6 --- /dev/null +++ b/LeanPool/GrahamLPT.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +/- +Adapted from JD-Jones-ASES/graham-lpt-lean, commit c8ed035b407cc554faf4b68df0cf3edc70058977. +Original MIT notice (retained under the permission to sublicense): + +MIT License + +Copyright (c) 2026 JD Jones + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. +-/ + +module + +public import LeanPool.GrahamLPT.Contracts +import Mathlib.Data.Rat.Floor +import Mathlib.Tactic.Positivity.Finset + +/-! +# Sharp list-scheduling and longest-processing-time bounds + +Source: url:https://github.com/JD-Jones-ASES/graham-lpt-lean/tree/c8ed035b407cc554faf4b68df0cf3edc70058977 +Authors: JD Jones +Status: verified +Main declarations: `GrahamLPT.lpt_le_optMakespan`, `GrahamLPT.lpt_eq_bound_iff_graham` +Tags: scheduling, approximation-algorithms, combinatorial-optimization +MSC: 68M20, 90B35, 68W25 +-/ + +/-! +## References and scope + +* R. L. Graham, *Bounds for certain multiprocessing anomalies* (1966), + DOI: 10.1002/j.1538-7305.1966.tb01709.x. +* R. L. Graham, *Bounds on multiprocessing timing anomalies* (1969), Theorem 2, + DOI: 10.1137/0117039. The bound here also permits zero-length jobs. +* G. Dósa, *Graham's example is the only tight one for P || Cmax* (2004), Theorem 2, + Annales Univ. Sci. Budapest. Sect. Math. 47, 207–210. The formal characterization + makes positive scaling, job permutation, nonempty instances and m ≥ 2 explicit. +* F. Della Croce and R. Scatamacchia, *The Longest Processing Time rule for identical + parallel machines revisited* (2020), arXiv:1801.05489, Propositions 2–4. + +The fixed-job-count supremum is a separate proved result. It is not a formalization +of the strict supremum gap asserted in Dósa's Remark 1. Processing-time bounds, +precedence constraints and an executable running-time analysis are outside this development. +-/ diff --git a/LeanPool/GrahamLPT/Basic.lean b/LeanPool/GrahamLPT/Basic.lean new file mode 100644 index 0000000000..70f1e30215 --- /dev/null +++ b/LeanPool/GrahamLPT/Basic.lean @@ -0,0 +1,313 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +public import Mathlib.Data.Finset.Max +import Mathlib.Algebra.BigOperators.Group.Finset.Piecewise +import Mathlib.Data.Fin.Tuple.Sort +import Mathlib.Data.Rat.Floor +import Mathlib.Tactic.Positivity.Finset + +/-! +# Basic + +Loads, makespans, the existence of list and LPT schedules, the attained optimum, relabeling. +Helpers carry the prefix `bs_`; the `_internal` twins of the Challenge theorems are closed in +`Contracts.lean`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +/-- No job has index below `0`. -/ +theorem bs_loadBefore_zero {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : Fin m) : + loadBefore p σ 0 i = 0 := by + simp [loadBefore] + +/-- Adding the job `k`. -/ +theorem bs_loadBefore_succ {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (k : Fin n) (i : Fin m) : + loadBefore p σ (k + 1) i = loadBefore p σ k i + if σ k = i then p k else 0 := by + unfold loadBefore + rw [Finset.sum_filter, Finset.sum_filter] + have e : (if σ k = i then p k else 0) = + ∑ j : Fin n, if j = k then (if σ j = i then p j else 0) else 0 := by + rw [Finset.sum_ite_eq'] + simp + rw [e, ← Finset.sum_add_distrib] + refine Finset.sum_congr rfl fun j _ => ?_ + by_cases hjk : j = k + · subst hjk + simp + · have hne : (j : ℕ) ≠ k := fun h => hjk (Fin.ext h) + by_cases h1 : (j : ℕ) < k + · have h2 : (j : ℕ) < k + 1 := by omega + simp [hjk, h1, h2] + · have h2 : ¬ (j : ℕ) < k + 1 := by omega + simp [hjk, h1, h2] + +/-- At or beyond the last index, `loadBefore` is the load. -/ +theorem bs_loadBefore_of_le {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (k : ℕ) (hk : n ≤ k) (i + : Fin m) : + loadBefore p σ k i = load p σ i := by + unfold loadBefore load + congr 1 + ext j + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + have := j.isLt + exact ⟨fun h => h.2, fun h => ⟨by omega, h⟩⟩ + +/-- The loads before `k` sum to the lengths of the jobs before `k`. -/ +theorem bs_sum_loadBefore {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (k : ℕ) : + ∑ i, loadBefore p σ k i = ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k), p j := by + unfold loadBefore + simp only [Finset.sum_filter] + rw [Finset.sum_comm] + refine Finset.sum_congr rfl fun j _ => ?_ + simp only [ite_and] + by_cases h : (j : ℕ) < k + · simp [h, Finset.sum_ite_eq] + · simp [h] + +/-- The loads sum to the total length. -/ +theorem bs_sum_load {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) : ∑ i, load p σ i = ∑ j, p j := by + unfold load + simp only [Finset.sum_filter] + rw [Finset.sum_comm] + refine Finset.sum_congr rfl fun j _ => ?_ + simp [Finset.sum_ite_eq] + +/-- The lengths of the jobs before `k`, plus `p k`, are at most the total (nonnegative lengths). -/ +theorem bs_sum_filter_add_le {n : ℕ} (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (k : Fin n) : + ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k), p j + p k ≤ ∑ j, p j := by + have hk : k ∉ univ.filter (fun j : Fin n => (j : ℕ) < k) := by simp + rw [add_comm, ← Finset.sum_insert hk] + exact Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ _) (fun j _ _ => hp j) + +theorem bs_loadBefore_mono {m n : ℕ} (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : Fin n → Fin m) {k k' + : ℕ} + (h : k ≤ k') (i : Fin m) : loadBefore p σ k i ≤ loadBefore p σ k' i := by + unfold loadBefore + refine Finset.sum_le_sum_of_subset_of_nonneg ?_ (fun j _ _ => hp j) + intro j hj + simp only [Finset.mem_filter, Finset.mem_univ, true_and] at hj ⊢ + exact ⟨by omega, hj.2⟩ + +theorem bs_loadBefore_le_load {m n : ℕ} (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : Fin n → Fin m) (k + : ℕ) + (i : Fin m) : loadBefore p σ k i ≤ load p σ i := by + unfold loadBefore load + refine Finset.sum_le_sum_of_subset_of_nonneg ?_ (fun j _ _ => hp j) + intro j hj + simp only [Finset.mem_filter, Finset.mem_univ, true_and] at hj ⊢ + exact hj.2 + +/-- The load of a machine with no job is `0`. -/ +theorem bs_load_eq_zero {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : Fin m) (h : ∀ j, σ j ≠ + i) : + load p σ i = 0 := by + unfold load + refine Finset.sum_eq_zero fun j hj => ?_ + simp only [Finset.mem_filter, Finset.mem_univ, true_and] at hj + exact absurd hj (h j) + +/-- With a cutoff `c`: a machine with a job of index below `c` has a last such job. -/ +theorem bs_exists_last_job_before {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (c : ℕ) (i : Fin m) + (h : ∃ j : Fin n, (j : ℕ) < c ∧ σ j = i) : + ∃ k : Fin n, (k : ℕ) < c ∧ σ k = i ∧ loadBefore p σ c i = loadBefore p σ k i + p k := by + obtain ⟨j0, hj0c, hj0⟩ := h + have hne : (univ.filter (fun j : Fin n => (j : ℕ) < c ∧ σ j = i)).Nonempty := + ⟨j0, by simp [hj0c, hj0]⟩ + obtain ⟨k, hkS, hkmax⟩ := Finset.exists_max_image _ (fun j : Fin n => (j : ℕ)) hne + simp only [Finset.mem_filter, Finset.mem_univ, true_and] at hkS + refine ⟨k, hkS.1, hkS.2, ?_⟩ + have e : loadBefore p σ c i = loadBefore p σ ((k : ℕ) + 1) i := by + unfold loadBefore + congr 1 + ext j + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + constructor + · rintro ⟨h1, h2⟩ + have h3 : (j : ℕ) ≤ k := hkmax j (by simp [h1, h2]) + exact ⟨by omega, h2⟩ + · rintro ⟨h1, h2⟩ + exact ⟨by omega, h2⟩ + rw [e, bs_loadBefore_succ] + simp [hkS.2] + +/-- A machine with a job has a last job `k`, and its load is the load before `k` plus `p k`. -/ +theorem bs_exists_last_job {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : Fin m) (h : ∃ j, σ j + = i) : + ∃ k : Fin n, σ k = i ∧ load p σ i = loadBefore p σ k i + p k := by + obtain ⟨j, hj⟩ := h + obtain ⟨k, -, hk, he⟩ := bs_exists_last_job_before p σ n i ⟨j, j.isLt, hj⟩ + exact ⟨k, hk, by rw [← bs_loadBefore_of_le p σ n le_rfl i, he]⟩ + +/-- A machine with no job of index below `c` has load `0` before `c`. -/ +theorem bs_loadBefore_eq_zero {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (c : ℕ) (i : Fin m) + (h : ∀ j : Fin n, (j : ℕ) < c → σ j ≠ i) : loadBefore p σ c i = 0 := by + unfold loadBefore + refine Finset.sum_eq_zero fun j hj => ?_ + simp only [Finset.mem_filter, Finset.mem_univ, true_and] at hj + exact absurd hj.2 (h j hj.1) + +/-- In a list schedule, `m` times the least load before `k` is at most the total length of the +jobs before `k`. -/ +theorem bs_mul_loadBefore_le {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) + (k : Fin n) : (m : ℝ) * loadBefore p σ k (σ k) ≤ ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < + k), p j := by + have h : ∑ _i : Fin m, loadBefore p σ k (σ k) ≤ ∑ i, loadBefore p σ k i := + Finset.sum_le_sum fun i _ => hσ k i + simpa only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul, + bs_sum_loadBefore] using h + +theorem bs_makespan_le_iff {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (c : ℝ) : + makespan p σ ≤ c ↔ ∀ i, load p σ i ≤ c := by + unfold makespan + rw [Finset.sup'_le_iff] + simp + +theorem bs_exists_load_eq_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) : + ∃ i, load p σ i = makespan p σ := by + obtain ⟨i, -, h⟩ := Finset.exists_mem_eq_sup' (univ_nonempty (α := Fin m)) (load p σ) + exact ⟨i, h.symm⟩ + +/-- Every machine load is at most the makespan (the helper behind the twin). -/ +theorem bs_load_le_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : Fin m) : + load p σ i ≤ makespan p σ := + Finset.le_sup' (load p σ) (mem_univ i) + +theorem bs_makespan_nonneg {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : Fin n → + Fin m) : + 0 ≤ makespan p σ := + le_trans (Finset.sum_nonneg fun j _ => hp j) (bs_load_le_makespan p σ 0) + +/-- Relabeling the jobs by a permutation changes no load. -/ +theorem bs_load_comp {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (π : Equiv.Perm (Fin n)) (i : + Fin m) : + load (p ∘ π) (σ ∘ π) i = load p σ i := by + unfold load + rw [Finset.sum_filter, Finset.sum_filter] + exact Equiv.sum_comp π (fun j => if σ j = i then p j else 0) + +/-- The total length is at most `m` times the makespan (the helper behind the twin). -/ +theorem bs_sum_le_mul_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) : + ∑ j, p j ≤ (m : ℝ) * makespan p σ := by + rw [← bs_sum_load p σ] + have h : ∑ i, load p σ i ≤ ∑ _i : Fin m, makespan p σ := + Finset.sum_le_sum fun i _ => bs_load_le_makespan p σ i + simpa [Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul] using h + +/-- The optimal makespan is attained (the helper behind the twin). -/ +theorem bs_exists_makespan_eq_opt {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : + ∃ τ : Fin n → Fin m, makespan p τ = optMakespan m p := by + obtain ⟨τ, -, h⟩ := Finset.exists_mem_eq_inf' (univ_nonempty (α := Fin n → Fin m)) + (fun σ : Fin n → Fin m => makespan p σ) + exact ⟨τ, h.symm⟩ + +/-- A least-loaded machine of a load vector (the greedy choice). -/ +noncomputable def leastLoadedMachine {m : ℕ} [NeZero m] (L : Fin m → ℝ) : Fin m := + Classical.choose (Finset.exists_min_image univ L univ_nonempty) + +theorem bs_argmin_le {m : ℕ} [NeZero m] (L : Fin m → ℝ) (i : Fin m) : L (leastLoadedMachine L) ≤ L + i := + (Classical.choose_spec (Finset.exists_min_image univ L univ_nonempty)).2 i (mem_univ i) + +/-- The greedy loads after the first `k` jobs. -/ +noncomputable def greedyLoads {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : ℕ → Fin m → ℝ + | 0 => fun _ => 0 + | k + 1 => fun i => greedyLoads p k i + + if i = leastLoadedMachine (greedyLoads p k) then (if h : k < n then p ⟨k, h⟩ else 0) else 0 + +theorem bs_loadBefore_greedy {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : + ∀ k : ℕ, k ≤ n → ∀ i : Fin m, loadBefore p (fun j : Fin n => leastLoadedMachine (greedyLoads p + (j : ℕ))) + k i = + greedyLoads p k i := by + intro k + induction k with + | zero => + intro _ i + rw [bs_loadBefore_zero] + rfl + | succ k ih => + intro hk i + have hkn : k < n := by omega + have e := bs_loadBefore_succ p (fun j : Fin n => leastLoadedMachine (greedyLoads p (j : ℕ))) + ⟨k, hkn⟩ i + simp only at e + rw [e, ih (by omega) i] + simp only [greedyLoads, hkn, ↓reduceDIte] + by_cases hi : i = leastLoadedMachine (greedyLoads p k) + · simp [hi] + · have hi' : ¬ leastLoadedMachine (greedyLoads p k) = i := fun h => hi h.symm + simp [hi, hi'] + +/-- A list schedule exists. -/ +theorem exists_isListSchedule_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : + ∃ σ : Fin n → Fin m, IsListSchedule p σ := by + refine ⟨fun j : Fin n => leastLoadedMachine (greedyLoads p (j : ℕ)), fun k i => ?_⟩ + rw [bs_loadBefore_greedy p k k.isLt.le, bs_loadBefore_greedy p k k.isLt.le] + exact bs_argmin_le _ i + +/-- An LPT schedule exists. -/ +theorem exists_isLPTSchedule_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : + ∃ σ : Fin n → Fin m, IsLPTSchedule p σ := by + set π := Tuple.sort (fun j => -p j) with hπ + have hanti : Antitone (p ∘ π) := by + intro a b hab + have := Tuple.monotone_sort (fun j => -p j) hab + simp only [Function.comp] at this ⊢ + linarith + obtain ⟨σ', hσ'⟩ := exists_isListSchedule_internal (m := m) (p ∘ π) + refine ⟨σ' ∘ π.symm, π, hanti, ?_⟩ + have e : (σ' ∘ ⇑π.symm) ∘ ⇑π = σ' := by + funext j + simp + rw [e] + exact hσ' + +/-- The optimal makespan is at most the makespan of every assignment. -/ +theorem optMakespan_le_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (τ : Fin n → Fin m) : + optMakespan m p ≤ makespan p τ := + Finset.inf'_le (fun σ : Fin n → Fin m => makespan p σ) (mem_univ τ) + +/-- The optimal makespan is attained. -/ +theorem exists_makespan_eq_optMakespan_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : + ∃ τ : Fin n → Fin m, makespan p τ = optMakespan m p := + bs_exists_makespan_eq_opt p + +/-- Every machine load is at most the makespan. -/ +theorem load_le_makespan_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : + Fin m) : + load p σ i ≤ makespan p σ := + bs_load_le_makespan p σ i + +/-- For nonnegative lengths every job is at most the makespan. -/ +theorem le_makespan_of_nonneg_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (σ : Fin n → Fin m) (j : Fin n) : p j ≤ makespan p σ := by + refine le_trans ?_ (bs_load_le_makespan p σ (σ j)) + exact Finset.single_le_sum (fun j _ => hp j) (by simp : j ∈ univ.filter (fun j' : Fin n => σ j' + = σ j)) + +/-- The total length is at most `m` times the makespan. -/ +theorem sum_le_mul_makespan_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) : + ∑ j, p j ≤ (m : ℝ) * makespan p σ := + bs_sum_le_mul_makespan p σ + +/-- Relabeling the jobs by a permutation does not change the makespan. -/ +theorem makespan_comp_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (π : + Equiv.Perm (Fin n)) : + makespan (p ∘ π) (σ ∘ π) = makespan p σ := by + have h : load (p ∘ π) (σ ∘ π) = load p σ := funext (bs_load_comp p σ π) + unfold makespan + rw [h] + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/Certificates.lean b/LeanPool/GrahamLPT/Certificates.lean new file mode 100644 index 0000000000..1d0823585d --- /dev/null +++ b/LeanPool/GrahamLPT/Certificates.lean @@ -0,0 +1,275 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +import LeanPool.GrahamLPT.Basic +import LeanPool.GrahamLPT.CoffmanSethi +import LeanPool.GrahamLPT.Key +import Mathlib.Algebra.BigOperators.Group.Finset.Piecewise +import Mathlib.Data.Finset.Max +import Mathlib.Tactic.Positivity.Finset + +/-! +# Certificates + +The critical job's certificates: the smaller of `C(σ)` and `3 p_k` bounds every comparison +schedule, the observed third certifies optimality, equality in Graham's bound forces its proof's +inequalities to be equalities, and Della Croce–Scatamacchia's Proposition 4 from Chen's property. +Helpers carry the prefix `ct_`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +/-- The key lemma against the makespan of `τ`: when `C(τ) < 3 p_k`, the machine of `k` ends by +`C(τ)`. -/ +theorem ct_key_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : Antitone p) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (τ : Fin n → Fin m) + (h3 : makespan p τ < 3 * p k) : loadBefore p σ k (σ k) + p k ≤ makespan p τ := + key_lemma p hp hanti σ hσ k τ (makespan p τ) + (fun i => (bs_loadBefore_le_load p hp τ _ i).trans (load_le_makespan_internal p τ i)) h3 + +/-- The scalar step of the equality structure for `T > 0`: `L` the least load before `k`, `P = +p_k`, `S` the +length before `k`, `W` the total, `T = C(τ)`; the four inequalities of Graham's proof and equality +in the bound +force `3P = T` and the chain `mL = S`, `S + P = W`, `W = mT`. -/ +theorem ct_eq_scalar (m L P S W T : ℝ) (hm : 2 ≤ m) (hT : 0 < T) (h1 : m * L ≤ S) (h2 : S + P ≤ W) + (h3 : W ≤ m * T) (hkey : T < 3 * P → L + P ≤ T) (heq : 3 * m * (L + P) = (4 * m - 1) * T) : + 3 * P = T ∧ S = m * L ∧ W = S + P ∧ W = m * T := by + have hm1 : 0 < m - 1 := by linarith + have hC : T < L + P := by + by_contra h + have hle : L + P ≤ T := le_of_not_gt h + have h4 := mul_le_mul_of_nonneg_left hle (by linarith : (0 : ℝ) ≤ 3 * m) + have h5 := mul_pos hm1 hT + nlinarith + have hP1 : 3 * P ≤ T := by + by_contra h + exact absurd (hkey (lt_of_not_ge h)) (not_le_of_gt hC) + have hP2 : T ≤ 3 * P := by + by_contra h + have h4 := mul_pos hm1 (by linarith [lt_of_not_ge h] : 0 < T - 3 * P) + nlinarith + have hP : 3 * P = T := le_antisymm hP1 hP2 + refine ⟨hP, ?_, ?_, ?_⟩ <;> nlinarith + +/-- The scalar step of Proposition 4: `s` the least load before the critical job, `P` its length, +`s + P` the +makespan of `σ`, `W` the total, `T = C(τ)`; the load count `(m − 1) s + (q + 1) P ≤ W ≤ mT` and +Chen's +`qP ≤ T` give the bound when `q + 2 ≤ m`. -/ +theorem ct_other_scalar (m q s P W T : ℝ) (hq : 0 ≤ q) (hmq : q + 2 ≤ m) + (hwork : (m - 1) * s + (q + 1) * P ≤ W) (htotal : W ≤ m * T) (hsize : q * P ≤ T) : + q * (m - 1) * (s + P) ≤ ((q + 1) * (m - 1) - 1) * T := by + have h1 := mul_le_mul_of_nonneg_left (hwork.trans htotal) hq + have h2 := mul_le_mul_of_nonneg_left hsize (by linarith : (0 : ℝ) ≤ m - q - 2) + nlinarith + +/-- The critical job's certificate: in a list schedule of a nonincreasing `p`, for a job `k` whose +completion time is +the makespan, the smaller of `C(σ)` and `3 p_k` is at most `C(τ)` for every assignment `τ` (the +key lemma read as a +lower bound on every comparison schedule). -/ +theorem lpt_critical_min_le_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (hanti : Antitone p) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (hk : makespan p σ = loadBefore p σ + k (σ k) + p k) + (τ : Fin n → Fin m) : min (makespan p σ) (3 * p k) ≤ makespan p τ := by + rcases le_or_gt (3 * p k) (makespan p τ) with h3 | h3 + · exact (min_le_right _ _).trans h3 + · have hkey := ct_key_le p hp hanti σ hσ k τ h3 + rw [← hk] at hkey + exact (min_le_left _ _).trans hkey + +/-- The observed-third certificate: in a list schedule of a nonincreasing `p`, when a critical job +`k` is at least a +third of the makespan it completes, the schedule is optimal (`lpt_eq_optMakespan_of_third_lt` asks +every job to exceed +a third of the unknown optimum). -/ +theorem lpt_eq_optMakespan_of_critical_third_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ + j, 0 ≤ p j) + (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) + (hk : makespan p σ = loadBefore p σ k (σ k) + p k) (h3 : makespan p σ ≤ 3 * p k) : + makespan p σ = optMakespan m p := by + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + have h := lpt_critical_min_le_internal p hp hanti σ hσ k hk τ + rw [min_eq_left h3, hτ] at h + exact le_antisymm h (optMakespan_le_internal p σ) + +/-- In a list schedule `σ` of a nonincreasing `p` on `m ≥ 2` machines, with `k` a critical job, +equality in Graham's +LPT bound against `τ` forces the four inequalities of its proof to be equalities: `3 p_k = C(τ)`, +every machine of +`σ` carries the least load before `k`, every machine of `τ` carries exactly `C(τ)`, and every job +after `k` has +length `0`. -/ +theorem lpt_eq_bound_structure_internal {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (p : Fin n → ℝ) (hp : ∀ + j, 0 ≤ p j) + (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) + (hk : makespan p σ = loadBefore p σ k (σ k) + p k) (τ : Fin n → Fin m) + (heq : 3 * m * makespan p σ = (4 * m - 1) * makespan p τ) : + 3 * p k = makespan p τ ∧ (∀ i, loadBefore p σ k i = loadBefore p σ k (σ k)) ∧ + (∀ i, load p τ i = makespan p τ) ∧ ∀ j : Fin n, (k : ℕ) < j → p j = 0 := by + have hm' : (2 : ℝ) ≤ m := by exact_mod_cast hm + have hT0 : 0 ≤ makespan p τ := bs_makespan_nonneg p hp τ + rcases hT0.eq_or_lt with hT | hT + · -- `C(τ) = 0`: then `C(σ) = 0` and every job has length `0` + have hC0 : makespan p σ = 0 := by + rw [← hT, mul_zero] at heq + have h3m : (0 : ℝ) < 3 * m := by linarith + exact (mul_eq_zero.mp heq).resolve_left h3m.ne' + have hz : ∀ j, p j = 0 := by + intro j + have h := le_makespan_of_nonneg_internal p hp σ j + rw [hC0] at h + exact le_antisymm h (hp j) + refine ⟨?_, ?_, ?_, fun j _ => hz j⟩ + · rw [hz k, ← hT] + ring + · intro i + unfold loadBefore + rw [Finset.sum_eq_zero (fun j _ => hz j), Finset.sum_eq_zero (fun j _ => hz j)] + · intro i + unfold load + rw [Finset.sum_eq_zero (fun j _ => hz j)] + exact hT + · -- `C(τ) > 0`: the scalar step, then each tight inequality read off + obtain ⟨hP, hS, hW, hWT⟩ := ct_eq_scalar (m : ℝ) (loadBefore p σ k (σ k)) (p k) + (∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k), p j) (∑ j, p j) (makespan p τ) hm' hT + (bs_mul_loadBefore_le p σ hσ k) (bs_sum_filter_add_le p hp k) (sum_le_mul_makespan_internal + p τ) + (ct_key_le p hp hanti σ hσ k τ) (by rw [← hk]; exact heq) + refine ⟨hP, ?_, ?_, ?_⟩ + · -- The nonnegative excesses sum to zero. + have hsum : ∑ i, (loadBefore p σ k i - loadBefore p σ k (σ k)) = 0 := by + simp only [Finset.sum_sub_distrib, bs_sum_loadBefore, Finset.sum_const, Finset.card_univ, + Fintype.card_fin, nsmul_eq_mul] + linarith + have h := (Finset.sum_eq_zero_iff_of_nonneg (fun i _ => sub_nonneg.2 (hσ k i))).mp hsum + intro i + have hi := h i (mem_univ i) + linarith + · -- every load of `τ` is its makespan: the slacks are nonnegative and sum to `mT − W = 0` + have hsum : ∑ i, (makespan p τ - load p τ i) = 0 := by + simp only [Finset.sum_sub_distrib, bs_sum_load, Finset.sum_const, Finset.card_univ, + Fintype.card_fin, + nsmul_eq_mul] + linarith + have h := (Finset.sum_eq_zero_iff_of_nonneg + (fun i _ => sub_nonneg.2 (load_le_makespan_internal p τ i))).mp hsum + intro i + have hi := h i (mem_univ i) + linarith + · -- every job after `k` has length `0`: `S + P + p_j ≤ W = S + P` + intro j hj + have hkA : k ∉ univ.filter (fun j : Fin n => (j : ℕ) < k) := by simp + have hjA : j ∉ insert k (univ.filter (fun j : Fin n => (j : ℕ) < k)) := by + simp only [mem_insert, mem_filter, mem_univ, true_and, Fin.ext_iff] + omega + have hsub := Finset.sum_le_sum_of_subset_of_nonneg + (Finset.subset_univ (insert j (insert k (univ.filter (fun j : Fin n => (j : ℕ) < k))))) + (fun x _ _ => hp x) + rw [Finset.sum_insert hjA, Finset.sum_insert hkA] at hsub + exact le_antisymm (by linarith) (hp j) + +/-- Della Croce–Scatamacchia's Proposition 4, from Chen's property: in a list schedule `σ` of a +nonincreasing `p`, if a +machine `i` other than the critical job's holds at least `q` jobs before the critical job `k`, and +`q + 2 ≤ m`, then +`q(m − 1) · C(σ) ≤ ((q + 1)(m − 1) − 1) · C(τ)` for every assignment `τ`. -/ +theorem lpt_bound_of_other_card_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (hanti : Antitone p) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (hk : makespan p σ = loadBefore p σ + k (σ k) + p k) + (i : Fin m) (hi : i ≠ σ k) (q : ℕ) (hq : q ≤ (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j + = i)).card) + (hqm : q + 2 ≤ m) (τ : Fin n → Fin m) : + (q : ℝ) * (m - 1) * makespan p σ ≤ ((q + 1) * (m - 1) - 1) * makespan p τ := by + have hm' : (q : ℝ) + 2 ≤ m := by exact_mod_cast hqm + have hq0 : (0 : ℝ) ≤ q := Nat.cast_nonneg q + have hT0 : 0 ≤ makespan p τ := bs_makespan_nonneg p hp τ + have hqF : (q : ℝ) ≤ (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)).card := by + exact_mod_cast hq + -- Chen's property at the last of the jobs before `k` on machine `i`: `q · p_k ≤ C(τ)` + have hqP : (q : ℝ) * p k ≤ makespan p τ := by + rcases Nat.eq_zero_or_pos q with hq0' | hqpos + · rw [hq0', Nat.cast_zero, zero_mul] + exact hT0 + · have hne : (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)).Nonempty := + Finset.card_pos.mp (by omega) + obtain ⟨j₀, hj₀F, hj₀max⟩ := Finset.exists_max_image _ (fun j : Fin n => (j : ℕ)) hne + have hj₀ : (j₀ : ℕ) < k ∧ σ j₀ = i := by simpa using hj₀F + have eF : univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i) = + insert j₀ (univ.filter (fun j : Fin n => (j : ℕ) < j₀ ∧ σ j = σ j₀)) := by + ext j + simp only [mem_filter, mem_univ, true_and, mem_insert] + constructor + · rintro ⟨h1, h2⟩ + have h3 : (j : ℕ) ≤ j₀ := hj₀max j (mem_filter.mpr ⟨mem_univ _, h1, h2⟩) + by_cases hjj : j = j₀ + · exact Or.inl hjj + · have : (j : ℕ) ≠ j₀ := fun e => hjj (Fin.ext e) + exact Or.inr ⟨by omega, h2.trans hj₀.2.symm⟩ + · rintro (rfl | ⟨h1, h2⟩) + · exact hj₀ + · exact ⟨by omega, h2.trans hj₀.2⟩ + have hnot : j₀ ∉ univ.filter (fun j : Fin n => (j : ℕ) < j₀ ∧ σ j = σ j₀) := by simp + have hcard : ((univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)).card : ℝ) = + ((univ.filter (fun j : Fin n => (j : ℕ) < j₀ ∧ σ j = σ j₀)).card : ℝ) + 1 := by + rw [eF, card_insert_of_notMem hnot] + push_cast + ring + have hchen := lpt_job_position_le_internal p hp hanti σ hσ j₀ τ + rw [← hcard] at hchen + have hpk : p k ≤ p j₀ := hanti (Fin.le_iff_val_le_val.mpr hj₀.1.le) + calc (q : ℝ) * p k ≤ (q : ℝ) * p j₀ := mul_le_mul_of_nonneg_left hpk hq0 + _ ≤ ((univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)).card : ℝ) * p j₀ := + mul_le_mul_of_nonneg_right hqF (hp j₀) + _ ≤ makespan p τ := hchen + -- the loads of `σ`: the machine of `k` carries `C(σ)`, machine `i` at least `q · p_k`, the rest + -- at least `L` + have hCk : loadBefore p σ k (σ k) + p k ≤ load p σ (σ k) := by + have h1 := bs_loadBefore_le_load p hp σ (k + 1) (σ k) + rw [bs_loadBefore_succ, ite_eq_left rfl] at h1 + exact h1 + have hFi : (q : ℝ) * p k ≤ loadBefore p σ k i := by + have h1 := key_card_mul_le_sum p hanti k (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)) + (fun j hj => by simp only [mem_filter, mem_univ, true_and] at hj; omega) + exact (mul_le_mul_of_nonneg_right hqF (hp k)).trans h1 + have hload_i : (q : ℝ) * p k ≤ load p σ i := hFi.trans (bs_loadBefore_le_load p hp σ k i) + have hload_other : ∀ i', loadBefore p σ k (σ k) ≤ load p σ i' := + fun i' => (hσ k i').trans (bs_loadBefore_le_load p hp σ k i') + have hpt : ∀ i' : Fin m, loadBefore p σ k (σ k) + (if i' = σ k then p k else 0) + + (if i' = i then (q : ℝ) * p k - loadBefore p σ k (σ k) else 0) ≤ load p σ i' := by + intro i' + by_cases h1 : i' = σ k + · have h2 : i' ≠ i := fun h => hi (h.symm.trans h1) + rw [ite_eq_left h1, ite_eq_right h2, add_zero, h1] + exact hCk + · rw [ite_eq_right h1, add_zero] + by_cases h2 : i' = i + · rw [ite_eq_left h2, h2] + linarith + · rw [ite_eq_right h2, add_zero] + exact hload_other i' + have hsum : (m : ℝ) * loadBefore p σ k (σ k) + p k + ((q : ℝ) * p k - loadBefore p σ k (σ k)) ≤ + ∑ j, p j := by + have h := Finset.sum_le_sum (fun i' (_ : i' ∈ (univ : Finset (Fin m))) => hpt i') + simp only [Finset.sum_add_distrib, Finset.sum_const, Finset.card_univ, Fintype.card_fin, + nsmul_eq_mul, + Finset.sum_ite_eq', Finset.mem_univ, ite_true, bs_sum_load] at h + exact h + rw [hk] + exact ct_other_scalar (m : ℝ) q (loadBefore p σ k (σ k)) (p k) (∑ j, p j) (makespan p τ) hq0 hm' + (by linarith) (sum_le_mul_makespan_internal p τ) hqP + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/CoffmanSethi.lean b/LeanPool/GrahamLPT/CoffmanSethi.lean new file mode 100644 index 0000000000..753bb49e51 --- /dev/null +++ b/LeanPool/GrahamLPT/CoffmanSethi.lean @@ -0,0 +1,422 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + + +import Mathlib.Algebra.BigOperators.Field +public import LeanPool.GrahamLPT.Defs +public import Mathlib.Algebra.Order.Archimedean.Real.Basic +import LeanPool.GrahamLPT.Basic +import Mathlib.Tactic.Positivity.Finset + +/-! +# CoffmanSethi + +Chen's property of LPT schedules (Chen 1993, as Della Croce–Scatamacchia 2020 restate it, +Proposition 2): in an LPT +schedule the `j`-th job placed on a machine has length at most `C(τ)/j` for every assignment `τ`; +hence, when a +machine attaining the makespan holds `k` jobs, `k·m·C(σ) ≤ ((k + 1)m − 1)·C(τ)` (the Coffman–Sethi +form). +Helpers carry the prefix `cs_`. + +The route (this development). Fix `P > 0` below every job placed so far and weigh a job `x` by +`⌊x/P⌋`. For two +machines `h, g` write `D` for the load of `h` minus the load of `g`, `Φ` for the weight of `h` +minus the number of +jobs on `g`, and `y` for the last job placed. The invariant `loadDifferenceInvariant` (`D ≥ 0 → +⌊D/P⌋ ≤ Φ`; +`D < 0 → −1 ≤ Φ ∧ ⌊(D + y)/P⌋ − 1 ≤ Φ`) holds at every step of a list schedule in nonincreasing +order, since a job +joins a least-loaded machine. With `g` the machine receiving job `k`, every machine weighs at +least the number of +jobs on `g` before `k`; summing over the machines and comparing with `τ`, where a machine's weight +is below `j` +when its load is below `j·p_k`, gives `j · p_k ≤ C(τ)`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +/-- The number of jobs of index below `k` on machine `i`, as an integer. -/ +def prefixJobCount {m n : ℕ} (σ : Fin n → Fin m) (k : ℕ) (i : Fin m) : ℤ := + ∑ _j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), (1 : ℤ) + +/-- The weight `Σ ⌊p_j / P⌋` of the jobs of index below `k` on machine `i`. -/ +noncomputable def prefixJobWeight {m n : ℕ} (p : Fin n → ℝ) (P : ℝ) (σ : Fin n → Fin m) (k : ℕ) (i + : Fin m) + : ℤ := + ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), ⌊p j / P⌋ + +/-- The two-machine invariant: `D` a load difference, `y` the last job, `Φ` a weight minus a +count. -/ +def loadDifferenceInvariant (P D y : ℝ) (Φ : ℤ) : Prop := + (0 ≤ D → ⌊D / P⌋ ≤ Φ) ∧ (D < 0 → -1 ≤ Φ ∧ ⌊(D + y) / P⌋ - 1 ≤ Φ) + +theorem cs_sum_succ {M : Type*} [AddCommMonoid M] {m n : ℕ} (f : Fin n → M) (σ : Fin n → Fin m) (k + : Fin n) + (i : Fin m) : + ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1 ∧ σ j = i), f j = + (∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), f j) + if σ k = i then f k else + 0 := by + by_cases h : σ k = i + · have e : univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1 ∧ σ j = i) = + insert k (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)) := by + ext j + simp only [mem_filter, mem_univ, true_and, mem_insert] + constructor + · rintro ⟨h1, h2⟩ + by_cases hjk : j = k + · exact Or.inl hjk + · have : (j : ℕ) ≠ k := fun e => hjk (Fin.ext e) + exact Or.inr ⟨by omega, h2⟩ + · rintro (rfl | ⟨h1, h2⟩) + · exact ⟨by omega, h⟩ + · exact ⟨by omega, h2⟩ + rw [e, sum_insert (by simp), ite_eq_left h, add_comm] + · have e : univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1 ∧ σ j = i) = + univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i) := by + ext j + simp only [mem_filter, mem_univ, true_and] + constructor + · rintro ⟨h1, h2⟩ + have hjk : j ≠ k := fun e => h (e ▸ h2) + have : (j : ℕ) ≠ k := fun e => hjk (Fin.ext e) + exact ⟨by omega, h2⟩ + · rintro ⟨h1, h2⟩ + exact ⟨by omega, h2⟩ + rw [e, ite_eq_right h, add_zero] + +theorem cs_sum_fiber {M : Type*} [AddCommMonoid M] {m n : ℕ} (f : Fin n → M) (σ : Fin n → Fin m) + (k : ℕ) : + ∑ i, ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), f j = + ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k), f j := by + simp only [Finset.sum_filter] + rw [Finset.sum_comm] + refine Finset.sum_congr rfl fun j _ => ?_ + simp only [ite_and] + by_cases h : (j : ℕ) < k + · simp [h, Finset.sum_ite_eq] + · simp [h] + +theorem cs_inv_mono {P D y y' : ℝ} {Φ : ℤ} (hP : 0 < P) (h : loadDifferenceInvariant P D y Φ) (hy + : y' ≤ y) : + loadDifferenceInvariant P D y' Φ := by + refine ⟨h.1, fun hD => ⟨(h.2 hD).1, ?_⟩⟩ + have h1 : ⌊(D + y') / P⌋ ≤ ⌊(D + y) / P⌋ := + Int.floor_le_floor (div_le_div_of_nonneg_right (by linarith) hP.le) + have := (h.2 hD).2 + omega + +theorem cs_inv_self {P y : ℝ} {Φ : ℤ} (hΦ : 0 ≤ Φ) : loadDifferenceInvariant P 0 y Φ := by + refine ⟨fun _ => by simpa using hΦ, fun h => absurd h (lt_irrefl 0)⟩ + +/-- The receiving machine is the second of the pair (`D ≥ 0`): it gains a job of length `x ≥ P`. -/ +theorem cs_inv_istep {P D y x : ℝ} {Φ : ℤ} (hP : 0 < P) (hx : P ≤ x) (hD : 0 ≤ D) (h : + loadDifferenceInvariant P D + y Φ) : + loadDifferenceInvariant P (D - x) x (Φ - 1) := by + have h0 := h.1 hD + have hf0 : 0 ≤ ⌊D / P⌋ := Int.floor_nonneg.2 (div_nonneg hD hP.le) + refine ⟨fun hD' => ?_, fun _ => ⟨by omega, ?_⟩⟩ + · have h1 : (D - x) / P ≤ D / P - 1 := by + rw [div_sub_one hP.ne', div_le_div_iff_of_pos_right hP] + linarith + have h2 : ⌊(D - x) / P⌋ ≤ ⌊D / P - 1⌋ := Int.floor_le_floor h1 + rw [Int.floor_sub_one] at h2 + omega + · have e : D - x + x = D := by ring + rw [e] + omega + +/-- The receiving machine is the first of the pair (`D ≤ 0`): it gains a job `x` with `P ≤ x ≤ y`. +-/ +theorem cs_inv_hstep {P D y x : ℝ} {Φ : ℤ} (hP : 0 < P) (hx : P ≤ x) (hxy : x ≤ y) (hD : D ≤ 0) + (h : loadDifferenceInvariant P D y Φ) : loadDifferenceInvariant P (D + x) x (Φ + ⌊x / P⌋) := by + have hf1 : 1 ≤ ⌊x / P⌋ := by + rw [Int.le_floor, Int.cast_one, le_div_iff₀ hP] + linarith + rcases hD.lt_or_eq with hD | hD + · obtain ⟨hm1, hy⟩ := h.2 hD + refine ⟨fun hD' => ?_, fun hD' => ⟨by omega, ?_⟩⟩ + · have h1 : ⌊(D + x) / P⌋ ≤ ⌊(D + y) / P⌋ := + Int.floor_le_floor (div_le_div_of_nonneg_right (by linarith) hP.le) + omega + · have h1 : ⌊(D + x + x) / P⌋ ≤ ⌊x / P⌋ := + Int.floor_le_floor (div_le_div_of_nonneg_right (by linarith) hP.le) + omega + · subst hD + have h0 := h.1 le_rfl + simp only [zero_div, Int.floor_zero] at h0 + refine ⟨fun _ => ?_, fun hD' => absurd hD' (by linarith)⟩ + rw [zero_add] + omega + +theorem cs_cnt_le_fl {m n : ℕ} (p : Fin n → ℝ) {P : ℝ} (hP : 0 < P) (σ : Fin n → Fin m) (k : ℕ) + (hk : ∀ j : Fin n, (j : ℕ) < k → P ≤ p j) (i : Fin m) : prefixJobCount σ k i ≤ prefixJobWeight + p P σ k i := by + unfold prefixJobCount prefixJobWeight + refine Finset.sum_le_sum fun j hj => ?_ + simp only [mem_filter, mem_univ, true_and] at hj + rw [Int.le_floor, Int.cast_one, le_div_iff₀ hP, one_mul] + exact hk j hj.1 + +theorem cs_cnt_zero {m n : ℕ} (σ : Fin n → Fin m) (i : Fin m) : prefixJobCount σ 0 i = 0 := by + simp [prefixJobCount] + +theorem cs_fl_zero {m n : ℕ} (p : Fin n → ℝ) (P : ℝ) (σ : Fin n → Fin m) (i : Fin m) : + prefixJobWeight p P σ + 0 i = 0 := by + simp [prefixJobWeight] + +/-- The invariant along a list schedule in nonincreasing order, for every pair of machines. -/ +theorem cs_inv_all {m n : ℕ} (p : Fin n → ℝ) (hanti : Antitone p) (σ : Fin n → Fin m) + (hσ : IsListSchedule p σ) {P : ℝ} (hP : 0 < P) : + ∀ k : ℕ, k ≤ n → (∀ j : Fin n, (j : ℕ) < k → P ≤ p j) → ∀ h g : Fin m, ∀ y : ℝ, + (∀ j : Fin n, (j : ℕ) + 1 = k → y ≤ p j) → + loadDifferenceInvariant P (loadBefore p σ k h - loadBefore p σ k g) y (prefixJobWeight p P σ + k h - prefixJobCount σ k g) := by + intro k + induction k with + | zero => + intro _ _ h g y _ + rw [bs_loadBefore_zero, bs_loadBefore_zero, cs_fl_zero, cs_cnt_zero, sub_self, sub_self] + exact cs_inv_self le_rfl + | succ k ih => + intro hk hPk h g y hy + set kk : Fin n := ⟨k, by omega⟩ with hkk + have hkv : (kk : ℕ) = k := rfl + have hPk' : ∀ j : Fin n, (j : ℕ) < k → P ≤ p j := fun j hj => hPk j (by omega) + have hx : P ≤ p kk := hPk kk (by simp [kk]) + have hyx : y ≤ p kk := hy kk (by simp [kk]) + have IH := ih (by omega) hPk' h g (p kk) (fun j hj => hanti (show j ≤ kk from Fin.le_def.2 + (by omega))) + by_cases hhg : h = g + · subst hhg + rw [sub_self] + refine cs_inv_self ?_ + have := cs_cnt_le_fl p hP σ (k + 1) hPk h + omega + have eL : ∀ i, loadBefore p σ (k + 1) i = loadBefore p σ k i + if σ kk = i then p kk else 0 := + fun i => bs_loadBefore_succ p σ kk i + have eF : ∀ i, prefixJobWeight p P σ (k + 1) i = prefixJobWeight p P σ k i + if σ kk = i then + ⌊p kk / P⌋ else 0 := + fun i => cs_sum_succ (fun j => ⌊p j / P⌋) σ kk i + have eC : ∀ i, prefixJobCount σ (k + 1) i = prefixJobCount σ k i + if σ kk = i then 1 else 0 := + fun i => cs_sum_succ (fun _ => (1 : ℤ)) σ kk i + have hmin : ∀ i, loadBefore p σ k (σ kk) ≤ loadBefore p σ k i := fun i => hσ kk i + rw [eL h, eL g, eF h, eC g] + by_cases h1 : σ kk = h + · have h2 : σ kk ≠ g := fun e => hhg (h1.symm.trans e) + rw [ite_eq_left h1, ite_eq_right h2, ite_eq_left h1, ite_eq_right h2, add_zero, add_zero] + have hD : loadBefore p σ k h - loadBefore p σ k g ≤ 0 := by + have := hmin g + rw [h1] at this + linarith + have := cs_inv_hstep hP hx le_rfl hD IH + have e1 : loadBefore p σ k h + p kk - loadBefore p σ k g = + loadBefore p σ k h - loadBefore p σ k g + p kk := by ring + have e2 : prefixJobWeight p P σ k h + ⌊p kk / P⌋ - prefixJobCount σ k g = + prefixJobWeight p P σ k h - prefixJobCount σ k g + ⌊p kk / P⌋ := by ring + rw [e1, e2] + exact cs_inv_mono hP this hyx + · rw [ite_eq_right h1, ite_eq_right h1, add_zero, add_zero] + by_cases h2 : σ kk = g + · rw [ite_eq_left h2, ite_eq_left h2] + have hD : 0 ≤ loadBefore p σ k h - loadBefore p σ k g := by + have := hmin h + rw [h2] at this + linarith + have := cs_inv_istep hP hx hD IH + have e1 : loadBefore p σ k h - (loadBefore p σ k g + p kk) = + loadBefore p σ k h - loadBefore p σ k g - p kk := by ring + have e2 : prefixJobWeight p P σ k h - (prefixJobCount σ k g + 1) = prefixJobWeight p P σ k + h - prefixJobCount σ k g - 1 := by + ring + rw [e1, e2] + exact cs_inv_mono hP this hyx + · rw [ite_eq_right h2, ite_eq_right h2, add_zero, add_zero] + exact cs_inv_mono hP IH hyx + +/-- Every machine weighs at least the number of jobs on the machine that receives job `k`, before +`k`. -/ +theorem cs_cnt_le_fl_of_min {m n : ℕ} (p : Fin n → ℝ) (hanti : Antitone p) (σ : Fin n → Fin m) + (hσ : IsListSchedule p σ) {P : ℝ} (hP : 0 < P) (k : Fin n) (hk : ∀ j : Fin n, (j : ℕ) < k → P + ≤ p j) + (h : Fin m) : prefixJobCount σ k (σ k) ≤ prefixJobWeight p P σ k h := by + have hI := cs_inv_all p hanti σ hσ hP k k.isLt.le hk h (σ k) P (fun j hj => hk j (by omega)) + have hD : 0 ≤ loadBefore p σ k h - loadBefore p σ k (σ k) := sub_nonneg.2 (hσ k h) + have h1 := hI.1 hD + have h2 : 0 ≤ ⌊(loadBefore p σ k h - loadBefore p σ k (σ k)) / P⌋ := Int.floor_nonneg.2 + (div_nonneg hD hP.le) + omega + +/-- Chen's property, sorted form: job `k` is the `(c + 1)`-th job on its machine, `c` the jobs of +smaller index +there; then `(c + 1) · p_k ≤ C(τ)` for every assignment `τ`. -/ +theorem cs_job_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : Antitone p) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (τ : Fin n → Fin m) : + (((univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = σ k)).card : ℝ) + 1) * p k ≤ makespan p τ + := by + set c := (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = σ k)).card with hc + have hτ0 : 0 ≤ makespan p τ := bs_makespan_nonneg p hp τ + rcases (hp k).eq_or_lt with h0 | hpos + · rw [← h0, mul_zero] + exact hτ0 + by_contra hlt + push Not at hlt + have hk : ∀ j : Fin n, (j : ℕ) < (k : ℕ) + 1 → p k ≤ p j := fun j hj => hanti (Fin.le_def.2 + (by omega)) + have hk' : ∀ j : Fin n, (j : ℕ) < k → p k ≤ p j := fun j hj => hk j (by omega) + have hcnt : prefixJobCount σ k (σ k) = (c : ℤ) := by simp [prefixJobCount, hc] + have e : univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1) = + insert k (univ.filter (fun j : Fin n => (j : ℕ) < k)) := by + ext j + simp only [mem_filter, mem_univ, true_and, mem_insert] + constructor + · intro h1 + by_cases hjk : j = k + · exact Or.inl hjk + · have : (j : ℕ) ≠ k := fun e => hjk (Fin.ext e) + exact Or.inr (by omega) + · rintro (rfl | h1) <;> omega + have hlow : (m : ℤ) * c + 1 ≤ ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1), ⌊p j / + p k⌋ := by + rw [e, sum_insert (by simp), div_self hpos.ne', Int.floor_one, + ← cs_sum_fiber (fun j => ⌊p j / p k⌋) σ k] + have h1 : ∑ _i : Fin m, (c : ℤ) ≤ + ∑ i, ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), ⌊p j / p k⌋ := + Finset.sum_le_sum fun i _ => by + have := cs_cnt_le_fl_of_min p hanti σ hσ hpos k hk' i + rw [hcnt] at this + exact this + simp only [sum_const, card_univ, Fintype.card_fin, nsmul_eq_mul] at h1 + linarith + have hfib : ∀ g : Fin m, + ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1 ∧ τ j = g), ⌊p j / p k⌋ ≤ (c : ℤ) + := by + intro g + have h1 : ((∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1 ∧ τ j = g), ⌊p j / p k⌋ + : ℤ) : ℝ) ≤ + loadBefore p τ ((k : ℕ) + 1) g / p k := by + push_cast + unfold loadBefore + rw [sum_div] + exact sum_le_sum fun j _ => Int.floor_le _ + have h2 := (bs_loadBefore_le_load p hp τ ((k : ℕ) + 1) g).trans (bs_load_le_makespan p τ g) + have h3 : loadBefore p τ ((k : ℕ) + 1) g / p k < (c : ℝ) + 1 := by + rw [div_lt_iff₀ hpos] + linarith + have h4 : ((∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1 ∧ τ j = g), ⌊p j / p k⌋ + : ℤ) : ℝ) < + ((c : ℤ) : ℝ) + 1 := by + have h5 := h1.trans_lt h3 + push_cast at h5 ⊢ + linarith + have h5 : (∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1 ∧ τ j = g), ⌊p j / p k⌋ : + ℤ) < + (c : ℤ) + 1 := by exact_mod_cast h4 + omega + have hup : ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1), ⌊p j / p k⌋ ≤ (m : ℤ) * c + := by + rw [← cs_sum_fiber (fun j => ⌊p j / p k⌋) τ ((k : ℕ) + 1)] + have h1 := Finset.sum_le_sum fun g (_ : g ∈ (univ : Finset (Fin m))) => hfib g + simp only [sum_const, card_univ, Fintype.card_fin, nsmul_eq_mul] at h1 + exact h1 + omega + +/-- The Coffman–Sethi form, sorted: a machine `i` attaining the makespan of a list schedule in +nonincreasing order, +holding `k` jobs, gives `k·m·C(σ) ≤ ((k + 1)m − 1)·C(τ)` for every assignment `τ`. -/ +theorem cs_bound {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : Antitone p) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (τ : Fin n → Fin m) (i : Fin m) + (hi : load p σ i = makespan p σ) : + ((univ.filter (fun j : Fin n => σ j = i)).card : ℝ) * m * makespan p σ ≤ + (((univ.filter (fun j : Fin n => σ j = i)).card + 1) * m - 1) * makespan p τ := by + have hm : (1 : ℝ) ≤ m := by + have := NeZero.ne m + exact_mod_cast Nat.one_le_iff_ne_zero.mpr this + have hτ0 : 0 ≤ makespan p τ := bs_makespan_nonneg p hp τ + rcases (univ.filter (fun j : Fin n => σ j = i)).eq_empty_or_nonempty with hE | hne + · have h0 : makespan p σ = 0 := by + rw [← hi] + unfold load + rw [hE, sum_empty] + rw [hE, h0, card_empty, Nat.cast_zero, mul_zero] + exact mul_nonneg (by linarith) hτ0 + · obtain ⟨k, hkF, hkmax⟩ := Finset.exists_max_image _ (fun j : Fin n => (j : ℕ)) hne + have hki : σ k = i := by simpa using hkF + have eF : univ.filter (fun j : Fin n => σ j = i) = + insert k (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)) := by + ext j + simp only [mem_filter, mem_univ, true_and, mem_insert] + constructor + · intro hj + have h1 : (j : ℕ) ≤ k := hkmax j (by simp [hj]) + by_cases hjk : j = k + · exact Or.inl hjk + · have : (j : ℕ) ≠ k := fun e => hjk (Fin.ext e) + exact Or.inr ⟨by omega, hj⟩ + · rintro (rfl | ⟨_, h2⟩) + · exact hki + · exact h2 + have hknot : k ∉ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i) := by simp + have hcard : (((univ.filter (fun j : Fin n => σ j = i)).card : ℕ) : ℝ) = + ((univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = σ k)).card : ℝ) + 1 := by + rw [eF, card_insert_of_notMem hknot, hki] + push_cast + ring + have hload : makespan p σ = loadBefore p σ k (σ k) + p k := by + rw [← hi, hki] + unfold load loadBefore + rw [eF, sum_insert hknot] + ring + have hchen := cs_job_le p hp hanti σ hσ k τ + rw [← hcard] at hchen + have h1 := bs_mul_loadBefore_le p σ hσ k + have h2 := bs_sum_filter_add_le p hp k + have h3 := bs_sum_le_mul_makespan p τ + have hmC : (m : ℝ) * makespan p σ ≤ m * makespan p τ + (m - 1) * p k := by + rw [hload] + linarith + have hc0 : (0 : ℝ) ≤ ((univ.filter (fun j : Fin n => σ j = i)).card : ℝ) := Nat.cast_nonneg _ + have h4 := mul_le_mul_of_nonneg_left hmC hc0 + have h5 := mul_le_mul_of_nonneg_left hchen (by linarith : (0 : ℝ) ≤ m - 1) + nlinarith + +/-- The Coffman–Sethi form of the LPT bound: if a machine `i` attaining the makespan of an LPT +schedule holds `q` jobs, +then `q·m · C(σ) ≤ ((q + 1)m − 1) · C(τ)` for every assignment `τ` (Coffman–Sethi 1976 as +corrected by Chen 1993, as +Della Croce and Scatamacchia restate it; the literature states it for `q ≥ 3`; for `m ≥ 2` it is +weaker than +`lpt_bound` at `q ≤ 2`, and its attainment is not proved here). -/ +theorem lpt_bound_of_card_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (τ : Fin n → Fin m) (i : Fin m) + (hi : load p σ i = makespan p σ) : + ((univ.filter (fun j : Fin n => σ j = i)).card : ℝ) * m * makespan p σ ≤ + (((univ.filter (fun j : Fin n => σ j = i)).card + 1) * m - 1) * makespan p τ := by + obtain ⟨π, hanti, hl⟩ := hσ + have hi' : load (p ∘ π) (σ ∘ π) i = makespan (p ∘ π) (σ ∘ π) := by + rw [bs_load_comp, makespan_comp_internal, hi] + have h := cs_bound (p ∘ π) (fun j => hp _) hanti (σ ∘ π) hl (τ ∘ π) i hi' + have hcard : (univ.filter (fun j : Fin n => (σ ∘ π) j = i)).card = + (univ.filter (fun j : Fin n => σ j = i)).card := + Finset.card_equiv π (fun j => by simp) + rwa [hcard, makespan_comp_internal, makespan_comp_internal] at h + +theorem lpt_job_position_le_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (hanti : Antitone p) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (τ : Fin n → Fin m) : + (((univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = σ k)).card : ℝ) + 1) * p k ≤ makespan p τ + := + cs_job_le p hp hanti σ hσ k τ + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/Contracts.lean b/LeanPool/GrahamLPT/Contracts.lean new file mode 100644 index 0000000000..750f17a677 --- /dev/null +++ b/LeanPool/GrahamLPT/Contracts.lean @@ -0,0 +1,255 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +public import Mathlib.Data.Fin.VecNotation +import LeanPool.GrahamLPT.Basic +import LeanPool.GrahamLPT.Certificates +import LeanPool.GrahamLPT.CoffmanSethi +import LeanPool.GrahamLPT.Counter +import LeanPool.GrahamLPT.Equality +import LeanPool.GrahamLPT.FixedCount +import LeanPool.GrahamLPT.GrahamScaled +import LeanPool.GrahamLPT.Key +import LeanPool.GrahamLPT.LPTBound +import LeanPool.GrahamLPT.LPTForm +import LeanPool.GrahamLPT.ListBound +import LeanPool.GrahamLPT.ListOptimum +import LeanPool.GrahamLPT.OptList +import LeanPool.GrahamLPT.Ratio +import LeanPool.GrahamLPT.TightLPT +import LeanPool.GrahamLPT.TightList +import Mathlib.Tactic.Positivity.Finset + +/-! +# Scheduling theorem contracts + +The named results of the upstream formalization, proved using the internal library. +The definitions and all theorem statements are preserved from that development. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +theorem exists_isListSchedule {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : + ∃ σ : Fin n → Fin m, IsListSchedule p σ := + exists_isListSchedule_internal p + +theorem exists_isLPTSchedule {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : + ∃ σ : Fin n → Fin m, IsLPTSchedule p σ := + exists_isLPTSchedule_internal p + +theorem optMakespan_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (τ : Fin n → Fin m) : + optMakespan m p ≤ makespan p τ := + optMakespan_le_internal p τ + +theorem exists_makespan_eq_optMakespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : + ∃ τ : Fin n → Fin m, makespan p τ = optMakespan m p := + exists_makespan_eq_optMakespan_internal p + +theorem load_le_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : Fin m) : + load p σ i ≤ makespan p σ := + load_le_makespan_internal p σ i + +theorem le_makespan_of_nonneg {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (σ : Fin n → Fin m) (j : Fin n) : p j ≤ makespan p σ := + le_makespan_of_nonneg_internal p hp σ j + +theorem sum_le_mul_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) : + ∑ j, p j ≤ (m : ℝ) * makespan p σ := + sum_le_mul_makespan_internal p σ + +theorem makespan_comp {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (π : Equiv.Perm + (Fin n)) : + makespan (p ∘ π) (σ ∘ π) = makespan p σ := + makespan_comp_internal p σ π + +theorem listSchedule_bound {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (τ : Fin n → Fin m) : + (m : ℝ) * makespan p σ ≤ (2 * m - 1) * makespan p τ := + listSchedule_bound_internal p hp σ hσ τ + +theorem listSchedule_le_optMakespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) : + makespan p σ ≤ (2 - 1 / m) * optMakespan m p := + listSchedule_le_optMakespan_internal p hp σ hσ + +theorem unitJobs_optMakespan (m : ℕ) [NeZero m] : optMakespan m (unitJobs m) = m := + unitJobs_optMakespan_internal m + +theorem unitJobs_listSchedule_makespan (m : ℕ) [NeZero m] (σ : Fin (m * (m - 1) + 1) → Fin m) + (hσ : IsListSchedule (unitJobs m) σ) : makespan (unitJobs m) σ = 2 * m - 1 := + unitJobs_listSchedule_makespan_internal m σ hσ + +theorem isLeast_listSchedule_ratio (m : ℕ) [NeZero m] : + IsLeast {c : ℝ | ∀ (n : ℕ) (p : Fin n → ℝ) (σ τ : Fin n → Fin m), (∀ j, 0 ≤ p j) → + IsListSchedule p σ → makespan p σ ≤ c * makespan p τ} (2 - 1 / m) := + isLeast_listSchedule_ratio_internal m + +theorem lpt_bound {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (τ : Fin n → Fin m) : + 3 * (m : ℝ) * makespan p σ ≤ (4 * m - 1) * makespan p τ := + lpt_bound_internal p hp σ hσ τ + +theorem lpt_le_optMakespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) : + makespan p σ ≤ (4 / 3 - 1 / (3 * m)) * optMakespan m p := + lpt_le_optMakespan_internal p hp σ hσ + +theorem lpt_optimal_of_third_lt {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (τ : Fin n → Fin m) + (h : ∀ j, makespan p τ < 3 * p j) : makespan p σ ≤ makespan p τ := + lpt_optimal_of_third_lt_internal p hp σ hσ τ h + +theorem lpt_eq_optMakespan_of_third_lt {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (h : ∀ j, optMakespan m p < 3 * p j) : + makespan p σ = optMakespan m p := + lpt_eq_optMakespan_of_third_lt_internal p hp σ hσ h + +theorem grahamJobs_antitone (m : ℕ) : Antitone (grahamJobs m) := + grahamJobs_antitone_internal m + +theorem grahamJobs_optMakespan (m : ℕ) [NeZero m] : optMakespan m (grahamJobs m) = 3 * m := + grahamJobs_optMakespan_internal m + +theorem grahamOrder_bijective (m : ℕ) : Function.Bijective (grahamOrder m) := + grahamOrder_bijective_internal m + +theorem grahamJobs_grahamOrder (m : ℕ) (i : Fin (2 * m + 1)) : + grahamJobs m (grahamOrder m i) = + if (i : ℕ) < m - 1 then 2 * (m : ℝ) - 1 - ((i : ℕ) : ℝ) + else if (i : ℕ) ≤ m then (m : ℝ) + else if (i : ℕ) < 2 * m then 3 * (m : ℝ) - ((i : ℕ) : ℝ) + else (m : ℝ) := + grahamJobs_grahamOrder_internal m i + +theorem grahamJobs_exists_optimal_listSchedule (m : ℕ) [NeZero m] : + ∃ σ : Fin (2 * m + 1) → Fin m, + IsListSchedule (grahamJobs m ∘ grahamOrder m) (σ ∘ grahamOrder m) ∧ makespan (grahamJobs m) + σ = 3 * m := + grahamJobs_exists_optimal_listSchedule_internal m + +theorem grahamJobs_lpt_makespan (m : ℕ) [NeZero m] (σ : Fin (2 * m + 1) → Fin m) + (hσ : IsLPTSchedule (grahamJobs m) σ) : makespan (grahamJobs m) σ = 4 * m - 1 := + grahamJobs_lpt_makespan_internal m σ hσ + +theorem isLeast_lpt_ratio (m : ℕ) [NeZero m] : + IsLeast {c : ℝ | ∀ (n : ℕ) (p : Fin n → ℝ) (σ τ : Fin n → Fin m), (∀ j, 0 ≤ p j) → + IsLPTSchedule p σ → makespan p σ ≤ c * makespan p τ} (4 / 3 - 1 / (3 * m)) := + isLeast_lpt_ratio_internal m + +theorem exists_listSchedule_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (τ : Fin n + → Fin m) : + ∃ (π : Equiv.Perm (Fin n)) (σ : Fin n → Fin m), + IsListSchedule (p ∘ π) (σ ∘ π) ∧ makespan p σ ≤ makespan p τ := + exists_listSchedule_le_internal p hp τ + +theorem isLeast_listSchedule_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) : + IsLeast ((fun σ : Fin n → Fin m => makespan p σ) '' + {σ | ∃ π : Equiv.Perm (Fin n), IsListSchedule (p ∘ π) (σ ∘ π)}) (optMakespan m p) := + isLeast_listSchedule_makespan_internal p hp + +theorem nine_five_four_lpt_thirteen : + IsLPTSchedule (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) (![0, 1, 2, 1, 2, 0] : Fin 6 → Fin 3) ∧ + makespan (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) (![0, 1, 2, 1, 2, 0] : Fin 6 → Fin 3) = 13 := + nine_five_four_lpt_thirteen_internal + +theorem nine_five_four_optMakespan : optMakespan 3 (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) = 12 := + nine_five_four_optMakespan_internal + +theorem lpt_third_le_not_optimal : + ∃ (p : Fin 6 → ℝ) (σ : Fin 6 → Fin 3), (∀ j, 0 ≤ p j) ∧ IsLPTSchedule p σ ∧ + (∀ j, optMakespan 3 p ≤ 3 * p j) ∧ optMakespan 3 p < makespan p σ := + lpt_third_le_not_optimal_internal + +theorem lpt_job_position_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : + Antitone p) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (τ : Fin n → Fin m) : + (((univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = σ k)).card : ℝ) + 1) * p k ≤ makespan p τ + := + lpt_job_position_le_internal p hp hanti σ hσ k τ + +theorem lpt_bound_of_card {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (τ : Fin n → Fin m) (i : Fin m) + (hi : load p σ i = makespan p σ) : + ((univ.filter (fun j : Fin n => σ j = i)).card : ℝ) * m * makespan p σ ≤ + (((univ.filter (fun j : Fin n => σ j = i)).card + 1) * m - 1) * makespan p τ := + lpt_bound_of_card_internal p hp σ hσ τ i hi + +theorem lpt_critical_min_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : + Antitone p) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (hk : makespan p σ = loadBefore p σ + k (σ k) + p k) + (τ : Fin n → Fin m) : min (makespan p σ) (3 * p k) ≤ makespan p τ := + lpt_critical_min_le_internal p hp hanti σ hσ k hk τ + +theorem lpt_eq_optMakespan_of_critical_third {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p + j) + (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) + (hk : makespan p σ = loadBefore p σ k (σ k) + p k) (h3 : makespan p σ ≤ 3 * p k) : + makespan p σ = optMakespan m p := + lpt_eq_optMakespan_of_critical_third_internal p hp hanti σ hσ k hk h3 + +theorem lpt_eq_bound_structure {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) + (hk : makespan p σ = loadBefore p σ k (σ k) + p k) (τ : Fin n → Fin m) + (heq : 3 * m * makespan p σ = (4 * m - 1) * makespan p τ) : + 3 * p k = makespan p τ ∧ (∀ i, loadBefore p σ k i = loadBefore p σ k (σ k)) ∧ + (∀ i, load p τ i = makespan p τ) ∧ ∀ j : Fin n, (k : ℕ) < j → p j = 0 := + lpt_eq_bound_structure_internal hm p hp hanti σ hσ k hk τ heq + +theorem lpt_bound_of_other_card {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : + Antitone p) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (hk : makespan p σ = loadBefore p σ + k (σ k) + p k) + (i : Fin m) (hi : i ≠ σ k) (q : ℕ) (hq : q ≤ (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j + = i)).card) + (hqm : q + 2 ≤ m) (τ : Fin n → Fin m) : + (q : ℝ) * (m - 1) * makespan p σ ≤ ((q + 1) * (m - 1) - 1) * makespan p τ := + lpt_bound_of_other_card_internal p hp hanti σ hσ k hk i hi q hq hqm τ + +theorem lpt_eq_bound_of_graham {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (a : ℝ) (ha : 0 < a) + (e : Fin n ≃ Fin (2 * m + 1)) (he : ∀ j, p j = a * grahamJobs m (e j)) (σ : Fin n → Fin m) + (hσ : IsLPTSchedule p σ) : 3 * m * makespan p σ = (4 * m - 1) * optMakespan m p := + lpt_eq_bound_of_graham_internal p a ha e he σ hσ + +theorem graham_of_listSchedule_eq_bound {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p : Fin n + → ℝ) + (hp : ∀ j, 0 < p j) (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) + (heq : 3 * m * makespan p σ = (4 * m - 1) * optMakespan m p) : + ∃ (a : ℝ) (h : n = 2 * m + 1), 0 < a ∧ ∀ j, p j = a * grahamJobs m (Fin.cast h j) := + graham_of_listSchedule_eq_bound_internal hm hn p hp hanti σ hσ heq + +theorem graham_of_lpt_eq_bound {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p : Fin n → ℝ) (hp + : ∀ j, 0 < p j) + (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (heq : 3 * m * makespan p σ = (4 * m - 1) * + optMakespan m p) : + ∃ (a : ℝ) (e : Fin n ≃ Fin (2 * m + 1)), 0 < a ∧ ∀ j, p j = a * grahamJobs m (e j) := + graham_of_lpt_eq_bound_internal hm hn p hp σ hσ heq + +theorem lpt_eq_bound_iff_graham {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p : Fin n → ℝ) + (hp : ∀ j, 0 < p j) : + (∃ σ : Fin n → Fin m, IsLPTSchedule p σ ∧ 3 * m * makespan p σ = (4 * m - 1) * optMakespan m + p) ↔ + ∃ (a : ℝ) (e : Fin n ≃ Fin (2 * m + 1)), 0 < a ∧ ∀ j, p j = a * grahamJobs m (e j) := + lpt_eq_bound_iff_graham_internal hm hn p hp + +theorem lpt_lt_bound_of_card_ne {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (hn' : n ≠ 2 * m + 1) + (p : Fin n → ℝ) (hp : ∀ j, 0 < p j) (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) : + 3 * m * makespan p σ < (4 * m - 1) * optMakespan m p := + lpt_lt_bound_of_card_ne_internal hm hn hn' p hp σ hσ + +theorem isLUB_lpt_ratio_of_card {m n : ℕ} [NeZero m] (hn : 2 * m + 1 ≤ n) : + IsLUB {r : ℝ | ∃ (p : Fin n → ℝ) (σ : Fin n → Fin m), (∀ j, 0 < p j) ∧ IsLPTSchedule p σ ∧ + r = makespan p σ / optMakespan m p} (4 / 3 - 1 / (3 * m)) := + isLUB_lpt_ratio_of_card_internal hn + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/Counter.lean b/LeanPool/GrahamLPT/Counter.lean new file mode 100644 index 0000000000..b447098cb6 --- /dev/null +++ b/LeanPool/GrahamLPT/Counter.lean @@ -0,0 +1,204 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +public import Mathlib.Data.Fin.VecNotation +import LeanPool.GrahamLPT.Basic +import Mathlib.Algebra.BigOperators.Fin +import Mathlib.Algebra.Order.Archimedean.Real.Basic +import Mathlib.Tactic.FinCases +import Mathlib.Tactic.Positivity.Finset + +/-! +# Counter + +The strict third cannot be weakened: on `3` machines the six jobs `9, 5, 5, 4, 4, 4` have an LPT +schedule of makespan `13` while the optimal makespan is `12`. Every job is at least a third of the +optimum (the jobs +of length `4` equal `12 / 3`), so `n ≤ 2m` alone does not make LPT optimal and the strict +hypothesis of +`lpt_optimal_of_third_lt` cannot be weakened to `≤`. Helpers carry the prefix `cx_`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +/-- A set of jobs all assigned to machine `i` has total length at most the load of `i` +(nonnegative lengths). -/ +theorem cx_sum_le_load {m n : ℕ} (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (τ : Fin n → Fin m) (i : Fin m) + (S : Finset (Fin n)) (hS : ∀ j ∈ S, τ j = i) : ∑ j ∈ S, p j ≤ load p τ i := by + unfold load + refine Finset.sum_le_sum_of_subset_of_nonneg (fun j hj => ?_) (fun j _ _ => hp j) + simpa using hS j hj + +/-- Among three machines, two values both different from two distinct values coincide. -/ +theorem cx_fin3_eq (a b c d : Fin 3) (hba : b ≠ a) (hca : c ≠ a) (hda : d ≠ a) (hcb : c ≠ b) + (hdb : d ≠ b) : c = d := by + have := a.isLt; have := b.isLt; have := c.isLt; have := d.isLt + simp only [ne_eq, Fin.ext_iff] at * + omega + +/-- Among three machines, a value different from `a` equals one of two distinct values different +from `a`. -/ +theorem cx_fin3_or (a b c d : Fin 3) (hba : b ≠ a) (hca : c ≠ a) (hcb : c ≠ b) (hda : d ≠ a) : + d = b ∨ d = c := by + have := a.isLt; have := b.isLt; have := c.isLt; have := d.isLt + simp only [ne_eq, Fin.ext_iff] at * + omega + +/-- `loadBefore` as a sum over all jobs with an `if`. -/ +theorem cx_loadBefore_eq {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (k : ℕ) (i : Fin m) : + loadBefore p σ k i = ∑ j : Fin n, if (j : ℕ) < k ∧ σ j = i then p j else 0 := by + unfold loadBefore + rw [Finset.sum_filter] + +/-- The instance `9, 5, 5, 4, 4, 4` is listed in nonincreasing order. -/ +theorem cx_antitone : Antitone (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) := by + intro a b h + revert h + fin_cases a <;> fin_cases b <;> simp [Fin.le_def] <;> norm_num + +/-- The assignment `0, 1, 2, 1, 2, 0` of the jobs `9, 5, 5, 4, 4, 4` to `3` machines is an LPT +schedule (the +identity order) and has makespan `13`. -/ +theorem cx_lpt_thirteen : + IsLPTSchedule (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) (![0, 1, 2, 1, 2, 0] : Fin 6 → Fin 3) ∧ + makespan (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) (![0, 1, 2, 1, 2, 0] : Fin 6 → Fin 3) = 13 := by + refine ⟨⟨1, ?_, ?_⟩, ?_⟩ + · simpa using cx_antitone + · intro k i + simp only [cx_loadBefore_eq, Fin.sum_univ_six, Function.comp_apply, Equiv.Perm.coe_one, id] + fin_cases k <;> fin_cases i <;> norm_num + · apply le_antisymm + · rw [bs_makespan_le_iff] + intro i + fin_cases i <;> norm_num [load, Finset.sum_filter, Fin.sum_univ_six] + · refine le_trans (le_of_eq ?_) (bs_load_le_makespan _ _ 0) + norm_num [load, Finset.sum_filter, Fin.sum_univ_six] + +/-- Every assignment of the jobs `9, 5, 5, 4, 4, 4` to `3` machines has a machine of load at least +`12`. -/ +theorem cx_twelve_le_makespan (τ : Fin 6 → Fin 3) : + 12 ≤ makespan (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) τ := by + set p : Fin 6 → ℝ := ![9, 5, 5, 4, 4, 4] with hpdef + have hp : ∀ j, 0 ≤ p j := by + intro j; fin_cases j <;> norm_num [hpdef] + by_contra hlt + push Not at hlt + have key : ∀ (i : Fin 3) (S : Finset (Fin 6)), (∀ j ∈ S, τ j = i) → 12 ≤ ∑ j ∈ S, p j → False := + by + intro i S hS h12 + have h1 := cx_sum_le_load p hp τ i S hS + have h2 := bs_load_le_makespan p τ i + linarith + -- job `0` (length `9`) shares its machine with no other job + by_cases h1 : τ 1 = τ 0 + · exact key (τ 0) {0, 1} (by simp [h1]) (by norm_num [hpdef]) + by_cases h2 : τ 2 = τ 0 + · exact key (τ 0) {0, 2} (by simp [h2]) (by norm_num [hpdef]) + by_cases h3 : τ 3 = τ 0 + · exact key (τ 0) {0, 3} (by simp [h3]) (by norm_num [hpdef]) + by_cases h4 : τ 4 = τ 0 + · exact key (τ 0) {0, 4} (by simp [h4]) (by norm_num [hpdef]) + by_cases h5 : τ 5 = τ 0 + · exact key (τ 0) {0, 5} (by simp [h5]) (by norm_num [hpdef]) + -- the jobs `3, 4, 5` (length `4`): two share a machine `x`, the third is on the remaining + -- machine `y`; + -- the jobs `1, 2` (length `5`) avoid `x` and so both join `y` + have finish : ∀ (x y : Fin 3) (u v w : Fin 6), τ u = x → τ v = x → τ w = y → x ≠ τ 0 → y ≠ τ 0 → + y ≠ x → + p u = 4 → p v = 4 → p w = 4 → u ≠ v → u ≠ 1 → v ≠ 1 → u ≠ 2 → v ≠ 2 → False := by + intro x y u v w hu hv hw hx0 hy0 hyx pu pv pw huv hu1 hv1 hu2 hv2 + by_cases g1 : τ 1 = x + · refine key x {1, u, v} ?_ ?_ + · intro j hj + simp only [mem_insert, mem_singleton] at hj + rcases hj with rfl | rfl | rfl <;> assumption + · rw [Finset.sum_insert (by simp [Ne.symm hu1, Ne.symm hv1]), Finset.sum_pair huv, pu, pv] + norm_num [hpdef] + by_cases g2 : τ 2 = x + · refine key x {2, u, v} ?_ ?_ + · intro j hj + simp only [mem_insert, mem_singleton] at hj + rcases hj with rfl | rfl | rfl <;> assumption + · rw [Finset.sum_insert (by simp [Ne.symm hu2, Ne.symm hv2]), Finset.sum_pair huv, pu, pv] + norm_num [hpdef] + have e1 : τ 1 = y := cx_fin3_eq (τ 0) x (τ 1) y hx0 h1 hy0 g1 hyx + have e2 : τ 2 = y := cx_fin3_eq (τ 0) x (τ 2) y hx0 h2 hy0 g2 hyx + have hw1 : w ≠ 1 := by rintro rfl; norm_num [hpdef] at pw + have hw2 : w ≠ 2 := by rintro rfl; norm_num [hpdef] at pw + refine key y {1, 2, w} ?_ ?_ + · intro j hj + simp only [mem_insert, mem_singleton] at hj + rcases hj with rfl | rfl | rfl <;> assumption + · rw [Finset.sum_insert (by simp [Ne.symm hw1]), Finset.sum_pair (Ne.symm hw2), pw] + norm_num [hpdef] + have p3 : p 3 = 4 := by simp [hpdef] + have p4 : p 4 = 4 := by simp [hpdef] + have p5 : p 5 = 4 := by simp [hpdef] + by_cases h34 : τ 4 = τ 3 + · by_cases h35 : τ 5 = τ 3 + · refine key (τ 3) {3, 4, 5} ?_ ?_ + · intro j hj + simp only [mem_insert, mem_singleton] at hj + rcases hj with rfl | rfl | rfl <;> simp [h34, h35] + · norm_num [hpdef] + · exact finish (τ 3) (τ 5) 3 4 5 rfl h34 rfl h3 h5 h35 p3 p4 p5 + (by decide) (by decide) (by decide) (by decide) (by decide) + · rcases cx_fin3_or (τ 0) (τ 3) (τ 4) (τ 5) h3 h4 h34 h5 with h53 | h54 + · exact finish (τ 3) (τ 4) 3 5 4 rfl h53 rfl h3 h4 h34 p3 p5 p4 + (by decide) (by decide) (by decide) (by decide) (by decide) + · exact finish (τ 4) (τ 3) 4 5 3 rfl h54 rfl h4 h3 (Ne.symm h34) p4 p5 p3 + (by decide) (by decide) (by decide) (by decide) (by decide) + +/-- The jobs `9, 5, 5, 4, 4, 4` have optimal makespan `12` on `3` machines, attained by `0, 1, 1, +2, 2, 2`. -/ +theorem cx_opt_twelve : optMakespan 3 (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) = 12 := by + apply le_antisymm + · refine le_trans (optMakespan_le_internal _ (![0, 1, 1, 2, 2, 2] : Fin 6 → Fin 3)) ?_ + rw [bs_makespan_le_iff] + intro i + fin_cases i <;> norm_num [load, Finset.sum_filter, Fin.sum_univ_six] + · obtain ⟨τ, hτ⟩ := bs_exists_makespan_eq_opt (m := 3) (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) + rw [← hτ] + exact cx_twelve_le_makespan τ + +/-- The strict hypothesis of `lpt_optimal_of_third_lt` cannot be weakened to `≤`, and `n ≤ 2m` +jobs do not make LPT +optimal: on `3` machines the six jobs `9, 5, 5, 4, 4, 4` are each at least a third of the optimal +makespan `12`, +yet an LPT schedule of them has makespan `13`. -/ +theorem cx_third_le_not_optimal : + ∃ (p : Fin 6 → ℝ) (σ : Fin 6 → Fin 3), (∀ j, 0 ≤ p j) ∧ IsLPTSchedule p σ ∧ + (∀ j, optMakespan 3 p ≤ 3 * p j) ∧ optMakespan 3 p < makespan p σ := by + refine ⟨![9, 5, 5, 4, 4, 4], ![0, 1, 2, 1, 2, 0], ?_, cx_lpt_thirteen.1, ?_, ?_⟩ + · intro j; fin_cases j <;> norm_num + · intro j + rw [cx_opt_twelve] + fin_cases j <;> norm_num + · rw [cx_opt_twelve, cx_lpt_thirteen.2] + norm_num + +theorem nine_five_four_lpt_thirteen_internal : + IsLPTSchedule (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) (![0, 1, 2, 1, 2, 0] : Fin 6 → Fin 3) ∧ + makespan (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) (![0, 1, 2, 1, 2, 0] : Fin 6 → Fin 3) = 13 := + cx_lpt_thirteen + +theorem nine_five_four_optMakespan_internal : optMakespan 3 (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) = 12 + := + cx_opt_twelve + +theorem lpt_third_le_not_optimal_internal : + ∃ (p : Fin 6 → ℝ) (σ : Fin 6 → Fin 3), (∀ j, 0 ≤ p j) ∧ IsLPTSchedule p σ ∧ + (∀ j, optMakespan 3 p ≤ 3 * p j) ∧ optMakespan 3 p < makespan p σ := + cx_third_le_not_optimal + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/Defs.lean b/LeanPool/GrahamLPT/Defs.lean new file mode 100644 index 0000000000..bcb9ad0a77 --- /dev/null +++ b/LeanPool/GrahamLPT/Defs.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import Mathlib.Data.Finset.Lattice.Fold +public import Mathlib.Data.Fintype.Pi +public import Mathlib.Algebra.Group.End + +public import Mathlib.Algebra.BigOperators.Group.Finset.Defs +public import Mathlib.Basic.Real.Basic +import Mathlib.Data.Rat.Floor +import Mathlib.Tactic.Positivity.Finset + + +/-! +# Identical-machine scheduling + +Machine loads and makespans, list schedules with arbitrary tie breaking, LPT schedules, +and the two families attaining Graham's bounds. Processing times are real numbers; +nonnegativity and positivity are imposed by the individual results that require them. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +/-- The load of machine `i` from the jobs of index below `k` under the assignment `σ`. -/ +def loadBefore {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (k : ℕ) (i : Fin m) : ℝ := + ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), p j + +/-- The load of machine `i`: the total length of the jobs assigned to it. -/ +def load {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : Fin m) : ℝ := + ∑ j ∈ univ.filter (fun j : Fin n => σ j = i), p j + +/-- The makespan of an assignment: its largest machine load. -/ +def makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) : ℝ := + univ.sup' univ_nonempty (load p σ) + +/-- The optimal makespan: the least makespan over all assignments of the `n` jobs to the `m` +machines. -/ +def optMakespan (m : ℕ) [NeZero m] {n : ℕ} (p : Fin n → ℝ) : ℝ := + univ.inf' univ_nonempty (fun σ : Fin n → Fin m => makespan p σ) + +/-- A list schedule in the index order: each job `k` goes to a machine whose load from the jobs +before `k` is least, +under any tie-breaking. -/ +def IsListSchedule {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) : Prop := + ∀ k : Fin n, ∀ i : Fin m, loadBefore p σ k (σ k) ≤ loadBefore p σ k i + +/-- An LPT schedule: a list schedule of the jobs taken in some nonincreasing order of length. -/ +def IsLPTSchedule {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) : Prop := + ∃ π : Equiv.Perm (Fin n), Antitone (p ∘ π) ∧ IsListSchedule (p ∘ π) (σ ∘ π) + +/-- Graham's instance for LPT: the `2m + 1` lengths `2m − 1, 2m − 1, 2m − 2, 2m − 2, …, m + 1, m + +1, m, m, m`. -/ +def grahamJobs (m : ℕ) : Fin (2 * m + 1) → ℝ := fun j => + if (j : ℕ) < 2 * m then 2 * (m : ℝ) - 1 - (((j : ℕ) / 2 : ℕ) : ℝ) else (m : ℝ) + +/-- The order `2m − 1, …, m + 1, m, m, 2m − 1, …, m + 1, m` of Graham's instance, as the job at +each position: +position `i < m − 1` holds job `2i` (length `2m − 1 − i`), positions `m − 1` and `m` hold jobs `2m +− 2` and `2m − 1` +(length `m`), position `m + 1 + a` with `a < m − 1` holds job `2a + 1` (length `2m − 1 − a`), and +position `2m` holds +job `2m` (length `m`). -/ +def grahamOrder (m : ℕ) (i : Fin (2 * m + 1)) : Fin (2 * m + 1) := + if h : (i : ℕ) < m - 1 then + ⟨2 * i, Nat.lt_succ_of_lt (Nat.lt_of_lt_of_le (Nat.mul_lt_mul_of_pos_left h Nat.two_pos) + (Nat.mul_le_mul_left 2 (Nat.sub_le m 1)))⟩ + else if (i : ℕ) = m - 1 then ⟨2 * m - 2, Nat.lt_succ_of_le (Nat.sub_le _ _)⟩ + else if (i : ℕ) = m then ⟨2 * m - 1, Nat.lt_succ_of_le (Nat.sub_le _ _)⟩ + else if h' : (i : ℕ) < 2 * m then + ⟨2 * ((i : ℕ) - m - 1) + 1, Nat.succ_lt_succ (Nat.mul_lt_mul_of_pos_left + (Nat.lt_of_le_of_lt + (Nat.sub_le_sub_right (Nat.sub_le_iff_le_add.2 (Nat.two_mul m ▸ Nat.le_of_lt h')) 1) + (Nat.sub_one_lt (Nat.ne_of_gt (Nat.lt_of_mul_lt_mul_left (a := 2) (b := 0) + (Nat.lt_of_le_of_lt (Nat.zero_le i) h'))))) + Nat.two_pos)⟩ + else ⟨2 * m, Nat.lt_succ_self _⟩ + +/-- Graham's instance for list scheduling: `m(m − 1)` unit jobs followed by one job of length `m`. +-/ +def unitJobs (m : ℕ) : Fin (m * (m - 1) + 1) → ℝ := fun j => + if (j : ℕ) < m * (m - 1) then 1 else (m : ℝ) + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/Equality.lean b/LeanPool/GrahamLPT/Equality.lean new file mode 100644 index 0000000000..5a71045b73 --- /dev/null +++ b/LeanPool/GrahamLPT/Equality.lean @@ -0,0 +1,626 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +import LeanPool.GrahamLPT.Basic +import LeanPool.GrahamLPT.Certificates +import LeanPool.GrahamLPT.Key +import LeanPool.GrahamLPT.TightLPT +import Mathlib.Algebra.BigOperators.Group.Finset.Piecewise +import Mathlib.Algebra.Order.Archimedean.Real.Basic +import Mathlib.Order.Interval.Finset.Fin +import Mathlib.Tactic.LinearCombination +import Mathlib.Tactic.Positivity.Finset + +/-! +# Equality + +The necessity half of Dósa's theorem, sorted form: equality forces `n = 2m + 1` and Graham's +instance up to a positive scale, by counting the jobs of each length on each machine of the two +schedules. Helpers carry the prefix `eq_`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +/-! ### Counting helpers -/ + +/-- On a two-element set whose values sum to `s`, the fibers at `x` and at `s − x` have the same +size. -/ +theorem eq_card_filter_pair {n : ℕ} (p : Fin n → ℝ) (S : Finset (Fin n)) (s x : ℝ) (hS : S.card = 2) + (hsum : ∑ j ∈ S, p j = s) : + (S.filter (fun j => p j = x)).card = (S.filter (fun j => p j = s - x)).card := by + obtain ⟨u, v, huv, rfl⟩ := Finset.card_eq_two.mp hS + rw [Finset.sum_pair huv] at hsum + rw [Finset.card_filter, Finset.card_filter, Finset.sum_pair huv, Finset.sum_pair huv] + have h1 : (p u = s - x) = (p v = x) := propext ⟨fun h => by linarith, fun h => by linarith⟩ + have h2 : (p v = s - x) = (p u = x) := propext ⟨fun h => by linarith, fun h => by linarith⟩ + simp only [h1, h2] + exact add_comm _ _ + +/-- On a set of constant value `t`, the fiber at `x ≠ t` is empty. -/ +theorem eq_card_filter_const {n : ℕ} (p : Fin n → ℝ) (S : Finset (Fin n)) (t x : ℝ) + (hS : ∀ j ∈ S, p j = t) (hx : x ≠ t) : (S.filter (fun j => p j = x)).card = 0 := by + rw [Finset.card_eq_zero, Finset.filter_eq_empty_iff] + intro j hj h + exact hx (h ▸ hS j hj) + +/-- The jobs of index below `k` number `k`. -/ +theorem eq_card_lt {n : ℕ} (k : Fin n) : (univ.filter (fun j : Fin n => (j : ℕ) < k)).card = k := by + have h : univ.filter (fun j : Fin n => (j : ℕ) < k) = Finset.Iio k := by + ext j + simp only [Finset.mem_filter, Finset.mem_univ, true_and, Finset.mem_Iio, Fin.lt_def] + rw [h, Fin.card_Iio] + +/-- No job after the critical job: `n = k + 1`. -/ +theorem eq_n_eq {n : ℕ} (k : Fin n) (hlast : ∀ j : Fin n, (j : ℕ) ≤ k) : n = (k : ℕ) + 1 := by + have hk := k.isLt + by_contra h + have : (k : ℕ) + 1 ≤ k := hlast ⟨(k : ℕ) + 1, by omega⟩ + omega + +/-! ### Step 3: two jobs on every machine before the critical job -/ + +/-- A set of jobs of index `≤ k` with sum `3t − δ` (`0 < δ`, `0 < t = p k`) has at most two jobs. -/ +theorem eq_card_le_two {n : ℕ} (p : Fin n → ℝ) (hanti : Antitone p) (k : Fin n) (t δ : ℝ) (ht : 0 + < t) + (hδ : 0 < δ) (hpk : p k = t) (S : Finset (Fin n)) (hS : ∀ j ∈ S, (j : ℕ) < (k : ℕ) + 1) + (hsum : ∑ j ∈ S, p j = 3 * t - δ) : S.card ≤ 2 := by + by_contra h + have h3 : (3 : ℝ) ≤ (S.card : ℝ) := by exact_mod_cast (show 3 ≤ S.card by omega) + have h1 := key_card_mul_le_sum p hanti k S hS + rw [hpk, hsum] at h1 + nlinarith + +/-- A set with sum `3t − δ > 0` is nonempty. -/ +theorem eq_card_pos {n : ℕ} (p : Fin n → ℝ) (t δ : ℝ) (hδt : δ < t) (ht : 0 < t) (S : Finset (Fin + n)) + (hsum : ∑ j ∈ S, p j = 3 * t - δ) : 1 ≤ S.card := by + by_contra h + have h0 : S = ∅ := Finset.card_eq_zero.mp (by omega) + rw [h0, Finset.sum_empty] at hsum + linarith + +/-- A set with sum `3t − δ` is not a single job: that job, of length `3t − δ`, would be alone on its +`τ`-machine (every other job is `≥ t > δ`), whose load `3t − δ` is not `3t`. -/ +theorem eq_card_ne_one {m n : ℕ} (p : Fin n → ℝ) (t δ : ℝ) (ht : 0 < t) (hδ : 0 < δ) (hδt : δ < t) + (hpt : ∀ j, t ≤ p j) (τ : Fin n → Fin m) + (hG : ∀ i, ∑ j ∈ univ.filter (fun j : Fin n => τ j = i), p j = 3 * t) (S : Finset (Fin n)) + (hsum : ∑ j ∈ S, p j = 3 * t - δ) : S.card ≠ 1 := by + intro h1 + obtain ⟨j₁, rfl⟩ := Finset.card_eq_one.mp h1 + rw [Finset.sum_singleton] at hsum + have hp0 : ∀ j, 0 ≤ p j := fun j => ht.le.trans (hpt j) + have hG1 := hG (τ j₁) + have hsing : univ.filter (fun j : Fin n => τ j = τ j₁) = {j₁} := by + rw [Finset.eq_singleton_iff_unique_mem] + refine ⟨by simp, fun j₂ hj₂ => ?_⟩ + by_contra hne + have hsub : ({j₁, j₂} : Finset (Fin n)) ⊆ univ.filter (fun j : Fin n => τ j = τ j₁) := by + intro x hx + rcases Finset.mem_insert.mp hx with rfl | hx + · simp + · rw [Finset.mem_singleton.mp hx]; exact hj₂ + have h2 := Finset.sum_le_sum_of_subset_of_nonneg hsub (fun x _ _ => hp0 x) + rw [Finset.sum_pair (fun h => hne h.symm), hG1] at h2 + have := hpt j₂ + linarith + rw [hsing, Finset.sum_singleton] at hG1 + linarith + +/-- Step 3: every machine holds exactly two jobs before the critical job. -/ +theorem eq_card_fiber_two {m n : ℕ} (p : Fin n → ℝ) (hanti : Antitone p) (k : Fin n) (t δ : ℝ) (ht + : 0 < t) + (hδ : 0 < δ) (hδt : δ < t) (hpk : p k = t) (hpt : ∀ j, t ≤ p j) (σ : Fin n → Fin m) + (hF : ∀ i, loadBefore p σ k i = 3 * t - δ) (τ : Fin n → Fin m) + (hG : ∀ i, ∑ j ∈ univ.filter (fun j : Fin n => τ j = i), p j = 3 * t) (i : Fin m) : + (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)).card = 2 := by + have hsum : ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), p j = 3 * t - δ := hF i + have hS : ∀ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), (j : ℕ) < (k : ℕ) + 1 := by + intro j hj + simp only [Finset.mem_filter, Finset.mem_univ, true_and] at hj + omega + have h1 := eq_card_le_two p hanti k t δ ht hδ hpk _ hS hsum + have h2 := eq_card_pos p t δ hδt ht _ hsum + have h3 := eq_card_ne_one p t δ ht hδ hδt hpt τ hG _ hsum + omega + +/-- Step 3: with two jobs on every machine before it, the critical job has index `2m`. -/ +theorem eq_val_eq_two_mul {m n : ℕ} (σ : Fin n → Fin m) (k : Fin n) + (hF2 : ∀ i, (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)).card = 2) : (k : ℕ) = 2 * m + := by + have h := Finset.card_eq_sum_card_fiberwise (f := σ) (s := univ.filter (fun j : Fin n => (j : ℕ) + < k)) + (t := univ) (fun _ _ => Finset.mem_coe.mpr (Finset.mem_univ _)) + rw [eq_card_lt] at h + have h' : ∀ i : Fin m, (univ.filter (fun j : Fin n => (j : ℕ) < k)).filter (fun j => σ j = i) = + univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i) := fun i => Finset.filter_filter _ _ _ + simp only [h', hF2, Finset.sum_const, Finset.card_univ, Fintype.card_fin, smul_eq_mul] at h + omega + +/-! ### Step 4: every job is at most `2t − δ` -/ + +theorem eq_le_two_t {m n : ℕ} (p : Fin n → ℝ) (hanti : Antitone p) (k : Fin n) (t δ : ℝ) (hδt : δ + ≤ t) + (hpk : p k = t) (hlast : ∀ j : Fin n, (j : ℕ) ≤ k) (σ : Fin n → Fin m) + (hF : ∀ i, loadBefore p σ k i = 3 * t - δ) + (hF2 : ∀ i, (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)).card = 2) (j : Fin n) : + p j ≤ 2 * t - δ := by + by_cases hjk : j = k + · rw [hjk, hpk]; linarith + · have hjlt : (j : ℕ) < k := lt_of_le_of_ne (hlast j) (fun h => hjk (Fin.ext h)) + obtain ⟨S, hSdef⟩ : ∃ S : Finset (Fin n), + S = univ.filter (fun j' : Fin n => (j' : ℕ) < k ∧ σ j' = σ j) := ⟨_, rfl⟩ + have hjS : j ∈ S := by + rw [hSdef] + simp only [Finset.mem_filter, Finset.mem_univ, true_and, and_true] + exact hjlt + have hsum : ∑ j' ∈ S, p j' = 3 * t - δ := by rw [hSdef]; exact hF (σ j) + have hcard : (S.erase j).card = 1 := by rw [Finset.card_erase_of_mem hjS, hSdef, hF2] + have h1 := Finset.add_sum_erase S p hjS + have h2 := key_card_mul_le_sum p hanti k (S.erase j) (fun j' hj' => by + have := (Finset.mem_erase.mp hj').2 + rw [hSdef] at this + simp only [Finset.mem_filter, Finset.mem_univ, true_and] at this + omega) + rw [hcard, hpk] at h2 + simp only [Nat.cast_one, one_mul] at h2 + linarith + +/-! ### Step 5: the machines of `τ` -/ + +/-- A set of jobs with sum `3t`, every job in `[t, 2t − δ]`, holds two jobs, or three jobs of +length `t`. -/ +theorem eq_tau_cases {n : ℕ} (p : Fin n → ℝ) (hanti : Antitone p) (k : Fin n) (t δ : ℝ) (ht : 0 < t) + (hδ : 0 < δ) (hδt : δ ≤ t) (hpk : p k = t) (hlast : ∀ j : Fin n, (j : ℕ) ≤ k) (hpt : ∀ j, t ≤ + p j) + (hle : ∀ j, p j ≤ 2 * t - δ) (S : Finset (Fin n)) (hsum : ∑ j ∈ S, p j = 3 * t) : + S.card = 2 ∨ (S.card = 3 ∧ ∀ j ∈ S, p j = t) := by + have h3 : S.card ≤ 3 := by + by_contra h + have h4 : (4 : ℝ) ≤ (S.card : ℝ) := by exact_mod_cast (show 4 ≤ S.card by omega) + have h1 := key_card_mul_le_sum p hanti k S (fun j _ => by have := hlast j; omega) + rw [hpk, hsum] at h1 + nlinarith + have h2 : 2 ≤ S.card := by + by_contra h + have hc : (S.card : ℝ) ≤ 1 := by exact_mod_cast (show S.card ≤ 1 by omega) + have h1 := Finset.sum_le_card_nsmul S p (2 * t - δ) (fun j _ => hle j) + rw [hsum, nsmul_eq_mul] at h1 + have h0 : (0 : ℝ) ≤ 2 * t - δ := by linarith + nlinarith [mul_le_mul_of_nonneg_right hc h0] + rcases Nat.lt_or_ge S.card 3 with h | h + · left; omega + · right + have hc3 : S.card = 3 := by omega + refine ⟨hc3, ?_⟩ + have hz : ∑ j ∈ S, (p j - t) = 0 := by + rw [Finset.sum_sub_distrib, hsum, Finset.sum_const, hc3, nsmul_eq_mul] + push_cast; ring + have := (Finset.sum_eq_zero_iff_of_nonneg (fun j _ => sub_nonneg.mpr (hpt j))).mp hz + intro j hj + linarith [this j hj] + +/-- `2m + 1` jobs on `m` machines, at most three each: some machine holds three. -/ +theorem eq_exists_three {m n : ℕ} (τ : Fin n → Fin m) (hn : n = 2 * m + 1) + (hle : ∀ i, (univ.filter (fun j : Fin n => τ j = i)).card ≤ 3) : + ∃ i, (univ.filter (fun j : Fin n => τ j = i)).card = 3 := by + by_contra h + push Not at h + have h2 : ∀ i, (univ.filter (fun j : Fin n => τ j = i)).card ≤ 2 := fun i => by + have := hle i; have := h i; omega + have hs := Finset.card_eq_sum_card_fiberwise (f := τ) (s := (univ : Finset (Fin n))) (t := univ) + (fun _ _ => Finset.mem_coe.mpr (Finset.mem_univ _)) + rw [Finset.card_univ, Fintype.card_fin] at hs + have hsum := Finset.sum_le_sum (fun i (_ : i ∈ (univ : Finset (Fin m))) => h2 i) + rw [Finset.sum_const, Finset.card_univ, Fintype.card_fin, smul_eq_mul] at hsum + omega + +/-! ### Step 6: the counts -/ + +/-- The jobs of length `x`: those before `k`, plus `k` itself when `p k = x`. -/ +theorem eq_count_split {n : ℕ} (p : Fin n → ℝ) (k : Fin n) (hlast : ∀ j : Fin n, (j : ℕ) ≤ k) (x : + ℝ) : + (univ.filter (fun j => p j = x)).card = + ((univ.filter (fun j : Fin n => (j : ℕ) < k)).filter (fun j => p j = x)).card + + if p k = x then 1 else 0 := by + have hJ : (univ : Finset (Fin n)).erase k = univ.filter (fun j : Fin n => (j : ℕ) < k) := by + ext j + simp only [Finset.mem_erase, Finset.mem_univ, and_true, Finset.mem_filter, true_and, ne_eq, + Fin.ext_iff] + have := hlast j + omega + rw [Finset.card_filter, Finset.card_filter, ← Finset.add_sum_erase univ _ (Finset.mem_univ k), hJ, + add_comm] + +/-- The first count symmetry: summed over the machines of `σ`, each holding two jobs of total `A` +before `k`, +the jobs before `k` of length `x` and of length `A − x` are equally many. -/ +theorem eq_count_sigma {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (k : Fin n) (A : ℝ) + (hF : ∀ i, ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), p j = A) + (hF2 : ∀ i, (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)).card = 2) (x : ℝ) : + ((univ.filter (fun j : Fin n => (j : ℕ) < k)).filter (fun j => p j = x)).card = + ((univ.filter (fun j : Fin n => (j : ℕ) < k)).filter (fun j => p j = A - x)).card := by + have key : ∀ y : ℝ, ((univ.filter (fun j : Fin n => (j : ℕ) < k)).filter (fun j => p j = + y)).card = + ∑ i : Fin m, ((univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)).filter (fun j => p j = + y)).card := by + intro y + rw [Finset.card_eq_sum_card_fiberwise (f := σ) (t := univ) + (fun _ _ => Finset.mem_coe.mpr (Finset.mem_univ _))] + refine Finset.sum_congr rfl fun i _ => ?_ + congr 1 + ext j + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + tauto + rw [key, key] + exact Finset.sum_congr rfl fun i _ => eq_card_filter_pair p _ A x (hF2 i) (hF i) + +/-- The second count symmetry: summed over the machines of `τ`, each holding two jobs of total +`3t` or three +jobs of length `t`, the jobs of length `x` and of length `3t − x` are equally many when `x ≠ t, +2t`. -/ +theorem eq_count_tau {m n : ℕ} (p : Fin n → ℝ) (τ : Fin n → Fin m) (t : ℝ) + (hG : ∀ i, ∑ j ∈ univ.filter (fun j : Fin n => τ j = i), p j = 3 * t) + (hGc : ∀ i, (univ.filter (fun j : Fin n => τ j = i)).card = 2 ∨ + ∀ j ∈ univ.filter (fun j : Fin n => τ j = i), p j = t) (x : ℝ) (hx : x ≠ t) (hx2 : x ≠ 2 * + t) : + (univ.filter (fun j => p j = x)).card = (univ.filter (fun j => p j = 3 * t - x)).card := by + have key : ∀ y : ℝ, (univ.filter (fun j => p j = y)).card = + ∑ i : Fin m, ((univ.filter (fun j : Fin n => τ j = i)).filter (fun j => p j = y)).card := by + intro y + rw [Finset.card_eq_sum_card_fiberwise (f := τ) (t := univ) + (fun _ _ => Finset.mem_coe.mpr (Finset.mem_univ _))] + refine Finset.sum_congr rfl fun i _ => ?_ + congr 1 + ext j + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + tauto + rw [key, key] + refine Finset.sum_congr rfl fun i _ => ?_ + rcases hGc i with h2 | hconst + · exact eq_card_filter_pair p _ (3 * t) x h2 (hG i) + · rw [eq_card_filter_const p _ t x hconst hx, + eq_card_filter_const p _ t (3 * t - x) hconst (by intro h; apply hx2; linarith)] + +/-- One step of the chain: the two symmetries carry the count at `t + (i + 1)δ` to the count at `t ++ iδ`. -/ +theorem eq_chain_step {m n : ℕ} (p : Fin n → ℝ) (σ τ : Fin n → Fin m) (k : Fin n) (t δ : ℝ) (hδ : + 0 < δ) + (hmδ : (m : ℝ) * δ = t) (hpk : p k = t) (hlast : ∀ j : Fin n, (j : ℕ) ≤ k) + (hF : ∀ i, ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), p j = 3 * t - δ) + (hF2 : ∀ i, (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)).card = 2) + (hG : ∀ i, ∑ j ∈ univ.filter (fun j : Fin n => τ j = i), p j = 3 * t) + (hGc : ∀ i, (univ.filter (fun j : Fin n => τ j = i)).card = 2 ∨ + ∀ j ∈ univ.filter (fun j : Fin n => τ j = i), p j = t) (i : ℕ) (hi : i + 1 < m) : + ((univ.filter (fun j : Fin n => (j : ℕ) < k)).filter (fun j => p j = t + ((i : ℝ) + 1) * + δ)).card = + ((univ.filter (fun j : Fin n => (j : ℕ) < k)).filter (fun j => p j = t + (i : ℝ) * δ)).card + := by + have hpos : 0 < ((i : ℝ) + 1) * δ := mul_pos (by positivity) hδ + have hi' : ((i : ℝ) + 1) * δ < t := by + have h1 : ((i : ℝ) + 1) < m := by exact_mod_cast hi + have := mul_lt_mul_of_pos_right h1 hδ + linarith + have hx1 : t + ((i : ℝ) + 1) * δ ≠ t := by intro h; linarith + have hx2 : t + ((i : ℝ) + 1) * δ ≠ 2 * t := by intro h; linarith + have hy1 : 2 * t - ((i : ℝ) + 1) * δ ≠ t := by intro h; linarith + have e1 := eq_count_split p k hlast (t + ((i : ℝ) + 1) * δ) + rw [hpk, ite_eq_right hx1.symm, add_zero] at e1 + have e2 := eq_count_tau p τ t hG hGc _ hx1 hx2 + have e3 := eq_count_split p k hlast (3 * t - (t + ((i : ℝ) + 1) * δ)) + rw [hpk, ite_eq_right (by intro h; apply hy1; linarith), add_zero] at e3 + have e4 := eq_count_sigma p σ k (3 * t - δ) hF hF2 (3 * t - (t + ((i : ℝ) + 1) * δ)) + have e5 : 3 * t - δ - (3 * t - (t + ((i : ℝ) + 1) * δ)) = t + (i : ℝ) * δ := by ring + rw [e5] at e4 + rw [← e1, e2, e3, e4] + +/-- The chain: every count `c'(t + iδ)`, `i < m`, equals `c'(t)`. -/ +theorem eq_chain {m n : ℕ} (p : Fin n → ℝ) (σ τ : Fin n → Fin m) (k : Fin n) (t δ : ℝ) (hδ : 0 < δ) + (hmδ : (m : ℝ) * δ = t) (hpk : p k = t) (hlast : ∀ j : Fin n, (j : ℕ) ≤ k) + (hF : ∀ i, ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), p j = 3 * t - δ) + (hF2 : ∀ i, (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)).card = 2) + (hG : ∀ i, ∑ j ∈ univ.filter (fun j : Fin n => τ j = i), p j = 3 * t) + (hGc : ∀ i, (univ.filter (fun j : Fin n => τ j = i)).card = 2 ∨ + ∀ j ∈ univ.filter (fun j : Fin n => τ j = i), p j = t) (i : ℕ) (hi : i < m) : + ((univ.filter (fun j : Fin n => (j : ℕ) < k)).filter (fun j => p j = t + (i : ℝ) * δ)).card = + ((univ.filter (fun j : Fin n => (j : ℕ) < k)).filter (fun j => p j = t)).card := by + induction i with + | zero => simp only [Nat.cast_zero, zero_mul, add_zero] + | succ i ih => + push_cast + rw [eq_chain_step p σ τ k t δ hδ hmδ hpk hlast hF hF2 hG hGc i hi] + exact ih (by omega) + +/-- The fibers at `t + iδ`, `i < m`, are disjoint: their union has the summed size. -/ +theorem eq_card_biUnion {n : ℕ} (p : Fin n → ℝ) (J : Finset (Fin n)) (m : ℕ) (t δ : ℝ) (hδ : 0 < + δ) : + ((Finset.range m).biUnion (fun i => J.filter (fun j => p j = t + (i : ℝ) * δ))).card = + ∑ i ∈ Finset.range m, (J.filter (fun j => p j = t + (i : ℝ) * δ)).card := by + apply Finset.card_biUnion + intro i _ i' _ hne + change Disjoint _ _ + rw [Finset.disjoint_filter] + intro j _ h1 h2 + apply hne + have h3 : (i : ℝ) * δ = (i' : ℝ) * δ := by linarith + have h4 : (i : ℝ) = i' := mul_right_cancel₀ hδ.ne' h3 + exact_mod_cast h4 + +/-- Step 6: every fiber at `t + iδ`, `i < m`, has two jobs, and they exhaust the jobs before `k`. -/ +theorem eq_step6 {n : ℕ} (p : Fin n → ℝ) (k : Fin n) (m : ℕ) (hm : 0 < m) (t δ : ℝ) (hδ : 0 < δ) + (hk : (k : ℕ) = 2 * m) (hpk : p k = t) (hlast : ∀ j : Fin n, (j : ℕ) ≤ k) + (hchain : ∀ i < m, ((univ.filter (fun j : Fin n => (j : ℕ) < k)).filter + (fun j => p j = t + (i : ℝ) * δ)).card = + ((univ.filter (fun j : Fin n => (j : ℕ) < k)).filter (fun j => p j = t)).card) + (h3 : 3 ≤ (univ.filter (fun j => p j = t)).card) : + (∀ i < m, ((univ.filter (fun j : Fin n => (j : ℕ) < k)).filter + (fun j => p j = t + (i : ℝ) * δ)).card = 2) ∧ + ∀ j : Fin n, (j : ℕ) < k → ∃ i < m, p j = t + (i : ℝ) * δ := by + obtain ⟨J, hJ⟩ : ∃ J : Finset (Fin n), J = univ.filter (fun j : Fin n => (j : ℕ) < k) := ⟨_, rfl⟩ + have hJcard : J.card = 2 * m := by rw [hJ, eq_card_lt, hk] + rw [← hJ] at hchain ⊢ + have hsplit := eq_count_split p k hlast t + rw [hpk, ite_eq_left rfl, ← hJ] at hsplit + have hc2 : 2 ≤ (J.filter (fun j => p j = t)).card := by omega + have hsub : (Finset.range m).biUnion (fun i => J.filter (fun j => p j = t + (i : ℝ) * δ)) ⊆ J := + Finset.biUnion_subset.mpr (fun i _ => Finset.filter_subset _ _) + have hcard := eq_card_biUnion p J m t δ hδ + have hsum : ∑ i ∈ Finset.range m, (J.filter (fun j => p j = t + (i : ℝ) * δ)).card = + m * (J.filter (fun j => p j = t)).card := by + rw [Finset.sum_congr rfl (fun i hi => hchain i (Finset.mem_range.mp hi)), Finset.sum_const, + Finset.card_range, smul_eq_mul] + have hle := Finset.card_le_card hsub + rw [hcard, hsum, hJcard] at hle + have hct : (J.filter (fun j => p j = t)).card = 2 := by + have hle' : m * (J.filter (fun j => p j = t)).card ≤ m * 2 := by rw [Nat.mul_comm m 2]; exact + hle + have := Nat.le_of_mul_le_mul_left hle' hm + omega + have hfib : ∀ i < m, (J.filter (fun j => p j = t + (i : ℝ) * δ)).card = 2 := + fun i hi => by rw [hchain i hi, hct] + refine ⟨hfib, fun j hj => ?_⟩ + have hunion : (Finset.range m).biUnion (fun i => J.filter (fun j => p j = t + (i : ℝ) * δ)) = J := + Finset.eq_of_subset_of_card_le hsub (by rw [hcard, hsum, hct, hJcard]; omega) + have hjJ : j ∈ J := by rw [hJ]; simp only [Finset.mem_filter, Finset.mem_univ, true_and]; exact hj + rw [← hunion] at hjJ + obtain ⟨i, hi, hji⟩ := Finset.mem_biUnion.mp hjJ + exact ⟨i, Finset.mem_range.mp hi, (Finset.mem_filter.mp hji).2⟩ + +/-! ### Step 7: the function -/ + +/-- Two antitone functions on `Fin N` with the same fiber sizes are equal: their value lists are +sorted and are +permutations of each other. -/ +theorem eq_antitone_eq_of_count {N : ℕ} (f g : Fin N → ℝ) (hf : Antitone f) (hg : Antitone g) + (h : ∀ x, (univ.filter (fun j => f j = x)).card = (univ.filter (fun j => g j = x)).card) : f = + g := by + have hcount : ∀ (h : Fin N → ℝ) (x : ℝ), Multiset.count x (univ.val.map h) = + (univ.filter (fun j => h j = x)).card := by + intro h x + rw [Multiset.count_map, Finset.card_def, Finset.filter_val] + congr 1 + exact Multiset.filter_congr (fun j _ => eq_comm) + have hms : (univ.val.map f) = (univ.val.map g) := by + rw [Multiset.ext] + intro x + rw [hcount, hcount, h] + rw [Fin.univ_val_map, Fin.univ_val_map, Multiset.coe_eq_coe] at hms + exact List.ofFn_injective (List.Perm.eq_of_sortedGE hf.sortedGE_ofFn hg.sortedGE_ofFn hms) + +theorem eq_cast_iff (m q i : ℕ) : (2 * (m : ℝ) - 1 - (q : ℝ) = (m : ℝ) + i) ↔ q + 1 + i = m := by + constructor + · intro h + have : (q : ℝ) + 1 + i = m := by linarith + exact_mod_cast this + · intro h + have : (q : ℝ) + 1 + i = m := by exact_mod_cast h + linarith + +theorem eq_cast_iff' (m i : ℕ) : ((m : ℝ) = (m : ℝ) + i) ↔ i = 0 := by + constructor + · intro h + have : (i : ℝ) = 0 := by linarith + exact_mod_cast this + · intro h + subst h + simp + +/-- Graham's instance takes the value `m + i`, `i < m`, three times for `i = 0` and twice +otherwise. -/ +theorem eq_grahamJobs_fiber (m i : ℕ) (hi : i < m) : + (univ.filter (fun j : Fin (2 * m + 1) => grahamJobs m j = (m : ℝ) + i)).card = + if i = 0 then 3 else 2 := by + by_cases hi0 : i = 0 + · subst hi0 + have hfib : univ.filter (fun j : Fin (2 * m + 1) => grahamJobs m j = (m : ℝ) + (0 : ℕ)) = + {(⟨2 * m - 2, by omega⟩ : Fin (2 * m + 1)), ⟨2 * m - 1, by omega⟩, ⟨2 * m, by omega⟩} := by + ext j + have hj := j.isLt + simp only [Finset.mem_filter, Finset.mem_univ, true_and, Finset.mem_insert, + Finset.mem_singleton, + Fin.ext_iff] + unfold grahamJobs + split_ifs with h + · rw [eq_cast_iff]; omega + · rw [eq_cast_iff']; omega + rw [hfib, ite_eq_left rfl, Finset.card_insert_of_notMem, Finset.card_pair] + · simp only [Ne, Fin.ext_iff]; omega + · simp only [Finset.mem_insert, Finset.mem_singleton, Fin.ext_iff]; omega + · have hfib : univ.filter (fun j : Fin (2 * m + 1) => grahamJobs m j = (m : ℝ) + i) = + {(⟨2 * (m - 1 - i), by omega⟩ : Fin (2 * m + 1)), ⟨2 * (m - 1 - i) + 1, by omega⟩} := by + ext j + have hj := j.isLt + simp only [Finset.mem_filter, Finset.mem_univ, true_and, Finset.mem_insert, + Finset.mem_singleton, + Fin.ext_iff] + unfold grahamJobs + split_ifs with h + · rw [eq_cast_iff]; omega + · rw [eq_cast_iff']; omega + rw [hfib, ite_eq_right hi0, Finset.card_pair] + simp only [Ne, Fin.ext_iff]; omega + +/-- Every value of Graham's instance is `m + i` for some `i < m`. -/ +theorem eq_grahamJobs_lattice (m : ℕ) (hm : 1 ≤ m) (j : Fin (2 * m + 1)) : + ∃ i < m, grahamJobs m j = (m : ℝ) + i := by + have hj := j.isLt + by_cases h : (j : ℕ) < 2 * m + · refine ⟨m - 1 - (j : ℕ) / 2, by omega, ?_⟩ + rw [tg_grahamJobs_apply_lt m j h, eq_cast_iff] + omega + · refine ⟨0, hm, ?_⟩ + rw [tg_grahamJobs_apply_last m j (by omega), eq_cast_iff'] + +/-- The fiber sizes of `p` and of `δ · grahamJobs m` agree at every real `x`. -/ +theorem eq_count_eq {m : ℕ} (hm : 0 < m) (p : Fin (2 * m + 1) → ℝ) (k : Fin (2 * m + 1)) (t δ : ℝ) + (hδ : 0 < δ) (hmδ : (m : ℝ) * δ = t) (hpk : p k = t) (hlast : ∀ j : Fin (2 * m + 1), (j : ℕ) ≤ + k) + (hfib : ∀ i < m, ((univ.filter (fun j : Fin (2 * m + 1) => (j : ℕ) < k)).filter + (fun j => p j = t + (i : ℝ) * δ)).card = 2) + (hlat : ∀ j : Fin (2 * m + 1), (j : ℕ) < k → ∃ i < m, p j = t + (i : ℝ) * δ) (x : ℝ) : + (univ.filter (fun j => p j = x)).card = + (univ.filter (fun j : Fin (2 * m + 1) => δ * grahamJobs m j = x)).card := by + have hscale : ∀ i : ℕ, t + (i : ℝ) * δ = δ * ((m : ℝ) + i) := fun i => by rw [← hmδ]; ring + have hg : ∀ i : ℕ, (univ.filter (fun j : Fin (2 * m + 1) => + δ * grahamJobs m j = δ * ((m : ℝ) + i))).card = + (univ.filter (fun j : Fin (2 * m + 1) => grahamJobs m j = (m : ℝ) + i)).card := by + intro i + congr 1 + ext j + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + exact mul_right_inj' hδ.ne' + by_cases hx : ∃ i < m, x = t + (i : ℝ) * δ + · obtain ⟨i, hi, rfl⟩ := hx + rw [eq_count_split p k hlast, hfib i hi, hpk, hscale, hg, eq_grahamJobs_fiber m i hi] + by_cases hi0 : i = 0 + · subst hi0 + rw [ite_eq_left (by rw [← hmδ]; push_cast; ring), ite_eq_left rfl] + · have hne : t ≠ δ * ((m : ℝ) + i) := by + intro h + have h1 : (i : ℝ) * δ = 0 := by rw [← hmδ] at h; linarith + rcases mul_eq_zero.mp h1 with h2 | h2 + · exact hi0 (by exact_mod_cast h2) + · exact hδ.ne' h2 + rw [ite_eq_right hne, ite_eq_right hi0] + · push Not at hx + have h1 : univ.filter (fun j => p j = x) = ∅ := by + rw [Finset.filter_eq_empty_iff] + intro j _ hj + rcases lt_or_eq_of_le (hlast j) with hlt | heq + · obtain ⟨i, hi, hji⟩ := hlat j hlt + exact hx i hi (by rw [← hj, hji]) + · have hjk : j = k := Fin.ext heq + rw [hjk, hpk] at hj + exact hx 0 hm (by rw [← hj]; simp) + have h2 : univ.filter (fun j : Fin (2 * m + 1) => δ * grahamJobs m j = x) = ∅ := by + rw [Finset.filter_eq_empty_iff] + intro j _ hj + obtain ⟨i, hi, hji⟩ := eq_grahamJobs_lattice m hm j + rw [hji, ← hscale] at hj + exact hx i hi hj.symm + rw [h1, h2] + +/-- Dósa's theorem (2004), the sorted form: a list schedule of a nonempty nonincreasing positive +`p` on `m ≥ 2` machines +attains Graham's bound against the optimum only for Graham's instance: then `n = 2m + 1` and `p` +is a positive +multiple of `grahamJobs m`. -/ +theorem graham_of_listSchedule_eq_bound_internal {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p + : Fin n → ℝ) + (hp : ∀ j, 0 < p j) (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) + (heq : 3 * m * makespan p σ = (4 * m - 1) * optMakespan m p) : + ∃ (a : ℝ) (h : n = 2 * m + 1), 0 < a ∧ ∀ j, p j = a * grahamJobs m (Fin.cast h j) := by + have hm0 : 0 < m := NeZero.pos m + have hmR : (2 : ℝ) ≤ m := by exact_mod_cast hm + have hp0 : ∀ j, 0 ≤ p j := fun j => (hp j).le + -- Step 1: the optimum and the critical job + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + rw [← hτ] at heq + have hT : 0 < makespan p τ := + lt_of_lt_of_le (hp ⟨0, hn⟩) (le_makespan_of_nonneg_internal p hp0 τ ⟨0, hn⟩) + have hCT : makespan p τ < makespan p σ := by + by_contra h + push Not at h + have h1 : 3 * (m : ℝ) * makespan p σ ≤ 3 * m * makespan p τ := + mul_le_mul_of_nonneg_left h (by positivity) + nlinarith [mul_pos (sub_pos.mpr (by linarith : (1 : ℝ) < m)) hT] + obtain ⟨i₀, hi₀⟩ := bs_exists_load_eq_makespan p σ + have hex : ∃ j, σ j = i₀ := by + by_contra h + push Not at h + rw [bs_load_eq_zero p σ i₀ h] at hi₀ + linarith + obtain ⟨k, hk, hload⟩ := bs_exists_last_job p σ i₀ hex + have hk' : makespan p σ = loadBefore p σ k (σ k) + p k := by rw [← hi₀, hload, hk] + -- Step 2: the structure + obtain ⟨h3, hLB, hloadτ, hzero⟩ := lpt_eq_bound_structure_internal hm p hp0 hanti σ hσ k hk' τ heq + have hlast : ∀ j : Fin n, (j : ℕ) ≤ k := fun j => by + by_contra h + push Not at h + exact (hp j).ne' (hzero j h) + obtain ⟨t, hpk⟩ : ∃ t : ℝ, p k = t := ⟨_, rfl⟩ + have ht : 0 < t := hpk ▸ hp k + obtain ⟨δ, hδ_def⟩ : ∃ δ : ℝ, δ = t / m := ⟨_, rfl⟩ + have hmR0 : (0 : ℝ) < m := by linarith + have hδ : 0 < δ := by rw [hδ_def]; exact div_pos ht hmR0 + have hmδ : (m : ℝ) * δ = t := by rw [hδ_def]; field_simp + have hδt : δ < t := by + rw [hδ_def, div_lt_iff₀ hmR0] + nlinarith + rw [hpk] at h3 + rw [hk', hpk, ← h3] at heq + have hL : loadBefore p σ k (σ k) = 3 * t - δ := by + have e : (m : ℝ) * loadBefore p σ k (σ k) = 3 * m * t - t := by linear_combination (1 / 3 : ℝ) + * heq + have e' : (m : ℝ) * loadBefore p σ k (σ k) = (m : ℝ) * (3 * t - δ) := by + rw [mul_sub, hmδ]; linear_combination e + exact mul_left_cancel₀ hmR0.ne' e' + have hpt : ∀ j, t ≤ p j := fun j => hpk ▸ hanti (Fin.le_iff_val_le_val.mpr (hlast j)) + have hF : ∀ i, loadBefore p σ k i = 3 * t - δ := fun i => by rw [hLB i, hL] + have hFsum : ∀ i, ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), p j = 3 * t - δ := + fun i => hF i + have hG : ∀ i, ∑ j ∈ univ.filter (fun j : Fin n => τ j = i), p j = 3 * t := fun i => by + rw [h3]; exact hloadτ i + -- Steps 3–5 + have hF2 := eq_card_fiber_two p hanti k t δ ht hδ hδt hpk hpt σ hF τ hG + have hk2 : (k : ℕ) = 2 * m := eq_val_eq_two_mul σ k hF2 + have hn' : n = 2 * m + 1 := by rw [eq_n_eq k hlast, hk2] + have hle : ∀ j, p j ≤ 2 * t - δ := eq_le_two_t p hanti k t δ hδt.le hpk hlast σ hF hF2 + have hcases := fun i => eq_tau_cases p hanti k t δ ht hδ hδt.le hpk hlast hpt hle _ (hG i) + have hGc : ∀ i, (univ.filter (fun j : Fin n => τ j = i)).card = 2 ∨ + ∀ j ∈ univ.filter (fun j : Fin n => τ j = i), p j = t := fun i => (hcases i).imp_right + And.right + have hle3 : ∀ i, (univ.filter (fun j : Fin n => τ j = i)).card ≤ 3 := fun i => by + rcases hcases i with h | h + · omega + · omega + obtain ⟨i₃, hi₃⟩ := eq_exists_three τ hn' hle3 + have hconst : ∀ j ∈ univ.filter (fun j : Fin n => τ j = i₃), p j = t := by + rcases hcases i₃ with h | h + · omega + · exact h.2 + have h3c : 3 ≤ (univ.filter (fun j => p j = t)).card := by + rw [← hi₃] + exact Finset.card_le_card (fun j hj => Finset.mem_filter.mpr ⟨Finset.mem_univ _, hconst j hj⟩) + -- Step 6 + have hchain := fun i hi => eq_chain p σ τ k t δ hδ hmδ hpk hlast hFsum hF2 hG hGc i hi + obtain ⟨hfib, hlat⟩ := eq_step6 p k m hm0 t δ hδ hk2 hpk hlast hchain h3c + -- Step 7 + subst hn' + refine ⟨δ, rfl, hδ, fun j => ?_⟩ + simp only [Fin.cast_refl, id] + have hcount := eq_count_eq hm0 p k t δ hδ hmδ hpk hlast hfib hlat + have hg_anti : Antitone (fun j => δ * grahamJobs m j) := fun a b hab => + mul_le_mul_of_nonneg_left (grahamJobs_antitone_internal m hab) hδ.le + exact congrFun (eq_antitone_eq_of_count p (fun j => δ * grahamJobs m j) hanti hg_anti hcount) j + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/FixedCount.lean b/LeanPool/GrahamLPT/FixedCount.lean new file mode 100644 index 0000000000..8c9eedf826 --- /dev/null +++ b/LeanPool/GrahamLPT/FixedCount.lean @@ -0,0 +1,381 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +import LeanPool.GrahamLPT.Basic +import LeanPool.GrahamLPT.Key +import LeanPool.GrahamLPT.LPTBound +import LeanPool.GrahamLPT.TightLPT +import Mathlib.Algebra.Order.Archimedean.Real.Basic +import Mathlib.Data.Fin.Tuple.Sort +import Mathlib.Data.Fintype.BigOperators +import Mathlib.Tactic.Positivity.Finset + +/-! +# FixedCount + +The supremum of the LPT ratio for a fixed number `n ≥ 2m + 1` of jobs: Graham's jobs followed by +small jobs. Helpers carry the prefix `fc_`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +/-- The lengths by index: Graham's `2m + 1` jobs (`2m − 1, 2m − 1, …, m, m, m`), then `ε`. -/ +noncomputable def paddedJobLength (m : ℕ) (ε : ℝ) (j : ℕ) : ℝ := + if j < 2 * m then 2 * (m : ℝ) - 1 - ((j / 2 : ℕ) : ℝ) else if j = 2 * m then (m : ℝ) else ε + +/-- Graham's `2m + 1` jobs followed by `n − 2m − 1` jobs of length `ε`. -/ +noncomputable def paddedJobs (m n : ℕ) (ε : ℝ) : Fin n → ℝ := fun j => paddedJobLength m ε j + +theorem fc_len_lt (m : ℕ) (ε : ℝ) (j : ℕ) (h : j < 2 * m) : + paddedJobLength m ε j = 2 * (m : ℝ) - 1 - ((j / 2 : ℕ) : ℝ) := by + unfold paddedJobLength + exact ite_eq_left h + +theorem fc_len_two_mul (m : ℕ) (ε : ℝ) : paddedJobLength m ε (2 * m) = m := by + unfold paddedJobLength + rw [ite_eq_right (lt_irrefl _), ite_eq_left rfl] + +theorem fc_len_gt (m : ℕ) (ε : ℝ) (j : ℕ) (h : 2 * m < j) : paddedJobLength m ε j = ε := by + have h1 : ¬ j < 2 * m := by omega + have h2 : ¬ j = 2 * m := by omega + unfold paddedJobLength + rw [ite_eq_right h1, ite_eq_right h2] + +/-- Each of Graham's jobs is at least `m`. -/ +theorem fc_le_len (m : ℕ) (ε : ℝ) (j : ℕ) (h : j ≤ 2 * m) : (m : ℝ) ≤ paddedJobLength m ε j := by + rcases Nat.lt_or_ge j (2 * m) with h1 | h1 + · rw [fc_len_lt m ε j h1] + have h2 : j / 2 + 1 ≤ m := by omega + have h3 : ((j / 2 : ℕ) : ℝ) + 1 ≤ (m : ℝ) := by exact_mod_cast h2 + linarith + · have h2 : j = 2 * m := by omega + rw [h2] + exact (fc_len_two_mul m ε).ge + +theorem fc_len_pos (m : ℕ) (ε : ℝ) (hm : 0 < m) (hε : 0 < ε) (j : ℕ) : 0 < paddedJobLength m ε j + := by + rcases Nat.lt_or_ge (2 * m) j with h | h + · rw [fc_len_gt m ε j h] + exact hε + · have h1 := fc_le_len m ε j h + have h2 : (0 : ℝ) < m := by exact_mod_cast hm + linarith + +theorem fc_jobs_pos (m n : ℕ) (ε : ℝ) (hm : 0 < m) (hε : 0 < ε) (j : Fin n) : 0 < paddedJobs m n ε + j := + fc_len_pos m ε hm hε j + +/-- For `ε ≤ m` the family is listed in nonincreasing order. -/ +theorem fc_antitone (m n : ℕ) (ε : ℝ) (hε : ε ≤ m) : Antitone (paddedJobs m n ε) := by + intro a b hab + have hab' : (a : ℕ) ≤ b := hab + change paddedJobLength m ε b ≤ paddedJobLength m ε a + rcases Nat.lt_or_ge (b : ℕ) (2 * m) with hb | hb + · rw [fc_len_lt m ε b hb, fc_len_lt m ε a (by omega)] + have h1 : (a : ℕ) / 2 ≤ (b : ℕ) / 2 := Nat.div_le_div_right hab' + have h2 : (((a : ℕ) / 2 : ℕ) : ℝ) ≤ (((b : ℕ) / 2 : ℕ) : ℝ) := by exact_mod_cast h1 + linarith + · rcases Nat.lt_or_ge (a : ℕ) (2 * m + 1) with ha | ha + · have h1 := fc_le_len m ε a (by omega) + rcases Nat.lt_or_ge (2 * m) (b : ℕ) with hb' | hb' + · rw [fc_len_gt m ε b hb'] + linarith + · have h2 : (b : ℕ) = 2 * m := by omega + rw [h2, fc_len_two_mul] + exact h1 + · simp only [fc_len_gt m ε a (by omega), fc_len_gt m ε b (by omega), le_refl] + +/-- The pairs `j, 2m − 1 − j` of the first `2m` jobs sum to `3m − 1`. -/ +theorem fc_pair (m : ℕ) (ε : ℝ) (j : ℕ) (h : j < 2 * m) : + paddedJobLength m ε j + paddedJobLength m ε (2 * m - 1 - j) = 3 * m - 1 := by + have key : ∀ a b : ℕ, a + b + 1 = m → + 2 * (m : ℝ) - 1 - (a : ℝ) + (2 * (m : ℝ) - 1 - (b : ℝ)) = 3 * m - 1 := by + intro a b hab + have : (a : ℝ) + b + 1 = m := by exact_mod_cast hab + linarith + rw [fc_len_lt m ε j h, fc_len_lt m ε (2 * m - 1 - j) (by omega)] + exact key _ _ (by omega) + +/-- The pairs `j, 2m − 3 − j` of the first `2m − 2` jobs sum to `3m`. -/ +theorem fc_pair' (m : ℕ) (ε : ℝ) (j : ℕ) (h : j < 2 * m - 2) : + paddedJobLength m ε j + paddedJobLength m ε (2 * m - 3 - j) = 3 * m := by + have key : ∀ a b : ℕ, a + b + 2 = m → + 2 * (m : ℝ) - 1 - (a : ℝ) + (2 * (m : ℝ) - 1 - (b : ℝ)) = 3 * m := by + intro a b hab + have : (a : ℝ) + b + 2 = m := by exact_mod_cast hab + linarith + rw [fc_len_lt m ε j (by omega), fc_len_lt m ε (2 * m - 3 - j) (by omega)] + exact key _ _ (by omega) + +/-- The first `2m` jobs sum to `3m² − m`. -/ +theorem fc_sum_lt (m n : ℕ) (ε : ℝ) (hn : 2 * m ≤ n) : + ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < 2 * m), paddedJobs m n ε j = 3 * (m : ℝ) ^ 2 - m + := + by + rw [sum_filter] + have h1 : ∑ j : Fin n, (if (j : ℕ) < 2 * m then paddedJobs m n ε j else 0) = + ∑ j ∈ (range n).filter (fun j => j < 2 * m), paddedJobLength m ε j := + (Fin.sum_univ_eq_sum_range (fun j => if j < 2 * m then paddedJobLength m ε j else 0) n).trans + (sum_filter (fun j => j < 2 * m) (paddedJobLength m ε)).symm + have h2 : (range n).filter (fun j => j < 2 * m) = range (2 * m) := by + ext j + simp only [mem_filter, mem_range] + omega + have h3 : ∑ j ∈ range (2 * m), paddedJobLength m ε j = + ∑ j ∈ range (2 * m), (2 * (m : ℝ) - 1 - ((j / 2 : ℕ) : ℝ)) := + sum_congr rfl fun j hj => fc_len_lt m ε j (mem_range.1 hj) + rw [h1, h2, h3, tg_sum_range_aux] + ring + +/-- The pairing `j ↦ min (j, 2m − 1 − j)` of the first `2m` jobs has every load `3m − 1` before +index `2m`. -/ +theorem fc_exists_prefix_pairing (m n : ℕ) [NeZero m] (ε : ℝ) (hn : 2 * m ≤ n) : + ∃ τ : Fin n → Fin m, ∀ i, loadBefore (paddedJobs m n ε) τ (2 * m) i = 3 * m - 1 := by + have hm : 0 < m := NeZero.pos m + refine ⟨fun j => if h : (j : ℕ) < 2 * m then ⟨min (j : ℕ) (2 * m - 1 - j), by omega⟩ + else ⟨0, hm⟩, fun i => ?_⟩ + have hi := i.isLt + unfold loadBefore + have hfib : univ.filter (fun j : Fin n => (j : ℕ) < 2 * m ∧ + (if h : (j : ℕ) < 2 * m then (⟨min (j : ℕ) (2 * m - 1 - j), by omega⟩ : Fin m) else ⟨0, hm⟩) + = i) = + {(⟨i, by omega⟩ : Fin n), ⟨2 * m - 1 - i, by omega⟩} := by + ext j + have hj := j.isLt + simp only [mem_filter, mem_univ, true_and, mem_insert, mem_singleton, Fin.ext_iff] + split_ifs with h1 <;> dsimp only <;> omega + rw [hfib, sum_pair (by rw [Ne, Fin.ext_iff]; dsimp only; omega)] + exact fc_pair m ε i (by omega) + +/-- Every list schedule of the family in its own order has every load `3m − 1` after the first +`2m` jobs (the +key lemma at `T = 3m − 1`, then the sum `m(3m − 1)`). -/ +theorem fc_loadBefore_two_mul (m n : ℕ) [NeZero m] (ε : ℝ) (hε0 : 0 < ε) (hε1 : ε ≤ m) + (hn : 2 * m + 1 ≤ n) (σ : Fin n → Fin m) (hσ : IsListSchedule (paddedJobs m n ε) σ) (i : Fin + m) : + loadBefore (paddedJobs m n ε) σ (2 * m) i = 3 * m - 1 := by + have hm : 0 < m := NeZero.pos m + have hmR : (1 : ℝ) ≤ m := by exact_mod_cast hm + have hp : ∀ j, 0 ≤ paddedJobs m n ε j := fun j => (fc_jobs_pos m n ε hm hε0 j).le + obtain ⟨τ, hτ⟩ := fc_exists_prefix_pairing m n ε (by omega) + have hle : ∀ i', loadBefore (paddedJobs m n ε) σ (2 * m) i' ≤ 3 * m - 1 := by + intro i' + by_cases hex : ∃ j : Fin n, (j : ℕ) < 2 * m ∧ σ j = i' + · obtain ⟨k, hk, hσk, heq⟩ := bs_exists_last_job_before (paddedJobs m n ε) σ (2 * m) i' hex + rw [heq, ← hσk] + apply key_lemma (paddedJobs m n ε) hp (fc_antitone m n ε hε1) σ hσ k τ (3 * m - 1) + · intro i'' + rw [← hτ i''] + exact bs_loadBefore_mono _ hp τ (by omega) i'' + · have := fc_le_len m ε k (by omega) + change (3 : ℝ) * m - 1 < 3 * paddedJobLength m ε k + linarith + · push Not at hex + rw [bs_loadBefore_eq_zero _ σ _ i' hex] + linarith + have htot := fc_sum_lt m n ε (by omega) + have hsum := bs_sum_loadBefore (paddedJobs m n ε) σ (2 * m) + by_contra hne + have hlt : loadBefore (paddedJobs m n ε) σ (2 * m) i < 3 * m - 1 := lt_of_le_of_ne (hle i) hne + have hs : ∑ i', loadBefore (paddedJobs m n ε) σ (2 * m) i' < ∑ _i' : Fin m, (3 * (m : ℝ) - 1) := + sum_lt_sum (fun i' _ => hle i') ⟨i, mem_univ _, hlt⟩ + rw [sum_const, card_univ, Fintype.card_fin, nsmul_eq_mul] at hs + nlinarith + +/-- Every list schedule of the family in its own order has makespan at least `4m − 1`: the job +`2m`, of length +`m`, lands on a machine of load `3m − 1`. -/ +theorem fc_le_makespan_listSchedule (m n : ℕ) [NeZero m] (ε : ℝ) (hε0 : 0 < ε) (hε1 : ε ≤ m) + (hn : 2 * m + 1 ≤ n) (σ : Fin n → Fin m) (hσ : IsListSchedule (paddedJobs m n ε) σ) : + 4 * (m : ℝ) - 1 ≤ makespan (paddedJobs m n ε) σ := by + have hm : 0 < m := NeZero.pos m + have hp : ∀ j, 0 ≤ paddedJobs m n ε j := fun j => (fc_jobs_pos m n ε hm hε0 j).le + obtain ⟨k, hk⟩ : ∃ k : Fin n, (k : ℕ) = 2 * m := ⟨⟨2 * m, by omega⟩, rfl⟩ + have h1 := fc_loadBefore_two_mul m n ε hε0 hε1 hn σ hσ (σ k) + have h2 := bs_loadBefore_succ (paddedJobs m n ε) σ k (σ k) + rw [hk, ite_eq_left rfl] at h2 + have h3 := bs_loadBefore_le_load (paddedJobs m n ε) hp σ (2 * m + 1) (σ k) + have h4 := load_le_makespan_internal (paddedJobs m n ε) σ (σ k) + have h5 : paddedJobs m n ε k = m := by + change paddedJobLength m ε k = m + rw [hk] + exact fc_len_two_mul m ε + linarith + +/-- An antitone relabeling of the family leaves the lengths unchanged (`Tuple.unique_antitone`). -/ +theorem fc_comp_eq (m n : ℕ) (ε : ℝ) (hε1 : ε ≤ m) (π : Equiv.Perm (Fin n)) + (h : Antitone (paddedJobs m n ε ∘ π)) : paddedJobs m n ε ∘ π = paddedJobs m n ε := by + have h1 : Antitone (paddedJobs m n ε ∘ ⇑(1 : Equiv.Perm (Fin n))) := by + simpa using fc_antitone m n ε hε1 + have h2 := Tuple.unique_antitone h h1 + simpa using h2 + +/-- Every LPT schedule of the family has makespan at least `4m − 1`. -/ +theorem fc_le_makespan_lpt (m n : ℕ) [NeZero m] (ε : ℝ) (hε0 : 0 < ε) (hε1 : ε ≤ m) + (hn : 2 * m + 1 ≤ n) (σ : Fin n → Fin m) (hσ : IsLPTSchedule (paddedJobs m n ε) σ) : + 4 * (m : ℝ) - 1 ≤ makespan (paddedJobs m n ε) σ := by + obtain ⟨π, hanti, hls⟩ := hσ + have hc := fc_comp_eq m n ε hε1 π hanti + rw [hc] at hls + have h1 := fc_le_makespan_listSchedule m n ε hε0 hε1 hn (σ ∘ π) hls + rw [← makespan_comp_internal (paddedJobs m n ε) σ π, hc] + exact h1 + +/-- The pairing `j ↦ min (j, 2m − 3 − j)` of the first `2m − 2` jobs, the three jobs of length `m` +and every +small job on the last machine: every load is at most `3m + nε`. -/ +theorem fc_exists_opt (m n : ℕ) [NeZero m] (ε : ℝ) (hε0 : 0 ≤ ε) (hn : 2 * m + 1 ≤ n) : + ∃ τ : Fin n → Fin m, ∀ i, load (paddedJobs m n ε) τ i ≤ 3 * m + n * ε := by + have hm : 0 < m := NeZero.pos m + refine ⟨fun j => if h : (j : ℕ) < 2 * m - 2 then ⟨min (j : ℕ) (2 * m - 3 - j), by omega⟩ + else ⟨m - 1, by omega⟩, fun i => ?_⟩ + have hi := i.isLt + have hnε : 0 ≤ (n : ℝ) * ε := mul_nonneg (Nat.cast_nonneg n) hε0 + unfold load + by_cases hlt : (i : ℕ) < m - 1 + · have hfib : univ.filter (fun j : Fin n => + (if h : (j : ℕ) < 2 * m - 2 then (⟨min (j : ℕ) (2 * m - 3 - j), by omega⟩ : Fin m) + else ⟨m - 1, by omega⟩) = i) = + {(⟨i, by omega⟩ : Fin n), ⟨2 * m - 3 - i, by omega⟩} := by + ext j + have hj := j.isLt + simp only [mem_filter, mem_univ, true_and, mem_insert, mem_singleton, Fin.ext_iff] + split_ifs with h1 <;> dsimp only <;> omega + rw [hfib, sum_pair (by rw [Ne, Fin.ext_iff]; dsimp only; omega)] + have := fc_pair' m ε i (by omega) + change paddedJobLength m ε i + paddedJobLength m ε (2 * m - 3 - i) ≤ 3 * m + n * ε + linarith only [this, hnε] + · have hfib : univ.filter (fun j : Fin n => + (if h : (j : ℕ) < 2 * m - 2 then (⟨min (j : ℕ) (2 * m - 3 - j), by omega⟩ : Fin m) + else ⟨m - 1, by omega⟩) = i) = + univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ)) := by + ext j + have hj := j.isLt + simp only [mem_filter, mem_univ, true_and, Fin.ext_iff] + split_ifs with h1 <;> dsimp only <;> omega + rw [hfib, ← sum_filter_add_sum_filter_not (univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ))) + (fun j : Fin n => (j : ℕ) < 2 * m + 1)] + have hA : (univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ))).filter + (fun j : Fin n => (j : ℕ) < 2 * m + 1) = + {(⟨2 * m - 2, by omega⟩ : Fin n), ⟨2 * m - 1, by omega⟩, ⟨2 * m, by omega⟩} := by + ext j + have hj := j.isLt + simp only [mem_filter, mem_univ, true_and, mem_insert, mem_singleton, Fin.ext_iff] + omega + have hB : ∑ j ∈ (univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ))).filter + (fun j : Fin n => ¬ (j : ℕ) < 2 * m + 1), paddedJobs m n ε j ≤ n * ε := by + calc ∑ j ∈ (univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ))).filter + (fun j : Fin n => ¬ (j : ℕ) < 2 * m + 1), paddedJobs m n ε j + = ∑ _j ∈ (univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ))).filter + (fun j : Fin n => ¬ (j : ℕ) < 2 * m + 1), ε := by + refine sum_congr rfl fun j hj => ?_ + simp only [mem_filter, mem_univ, true_and] at hj + exact fc_len_gt m ε j (by omega) + _ = (((univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ))).filter + (fun j : Fin n => ¬ (j : ℕ) < 2 * m + 1)).card : ℝ) * ε := by + rw [sum_const, nsmul_eq_mul] + _ ≤ n * ε := by + apply mul_le_mul_of_nonneg_right _ hε0 + have := card_le_univ ((univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ))).filter + (fun j : Fin n => ¬ (j : ℕ) < 2 * m + 1)) + rw [Fintype.card_fin] at this + exact_mod_cast this + rw [hA, sum_insert (by simp only [mem_insert, mem_singleton, Fin.ext_iff]; omega), + sum_pair (by rw [Ne, Fin.ext_iff]; dsimp only; omega)] + have e1 : paddedJobs m n ε ⟨2 * m - 2, by omega⟩ = m := by + change paddedJobLength m ε (2 * m - 2) = m + rw [fc_len_lt m ε (2 * m - 2) (by omega)] + have h : (2 * m - 2) / 2 + 1 = m := by omega + have h' : (((2 * m - 2) / 2 : ℕ) : ℝ) + 1 = m := by exact_mod_cast h + linarith only [h'] + have e2 : paddedJobs m n ε ⟨2 * m - 1, by omega⟩ = m := by + change paddedJobLength m ε (2 * m - 1) = m + rw [fc_len_lt m ε (2 * m - 1) (by omega)] + have h : (2 * m - 1) / 2 + 1 = m := by omega + have h' : (((2 * m - 1) / 2 : ℕ) : ℝ) + 1 = m := by exact_mod_cast h + linarith only [h'] + have e3 : paddedJobs m n ε ⟨2 * m, by omega⟩ = m := fc_len_two_mul m ε + rw [e1, e2, e3] + linarith only [hB] + +/-- The optimum of the family is at most `3m + nε`. -/ +theorem fc_optMakespan_le (m n : ℕ) [NeZero m] (ε : ℝ) (hε0 : 0 ≤ ε) (hn : 2 * m + 1 ≤ n) : + optMakespan m (paddedJobs m n ε) ≤ 3 * m + n * ε := by + obtain ⟨τ, hτ⟩ := fc_exists_opt m n ε hε0 hn + exact (optMakespan_le_internal _ τ).trans ((bs_makespan_le_iff _ _ _).2 hτ) + +/-- A positive instance with a job has a positive optimum. -/ +theorem fc_optMakespan_pos {m n : ℕ} [NeZero m] (hn : 0 < n) (p : Fin n → ℝ) (hp : ∀ j, 0 < p j) : + 0 < optMakespan m p := by + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + rw [← hτ] + exact lt_of_lt_of_le (hp ⟨0, hn⟩) (le_makespan_of_nonneg_internal p (fun j => (hp j).le) τ ⟨0, + hn⟩) + +/-- For every fixed number `n ≥ 2m + 1` of jobs, Graham's constant `4/3 − 1/(3m)` is still the +supremum of +`C(σ)/optMakespan` over the LPT schedules of the positive instances with `n` jobs (for `m ≥ 2` it +is attained only at +`n = 2m + 1`, `lpt_lt_bound_of_card_ne`). -/ +theorem isLUB_lpt_ratio_of_card_internal {m n : ℕ} [NeZero m] (hn : 2 * m + 1 ≤ n) : + IsLUB {r : ℝ | ∃ (p : Fin n → ℝ) (σ : Fin n → Fin m), (∀ j, 0 < p j) ∧ IsLPTSchedule p σ ∧ + r = makespan p σ / optMakespan m p} (4 / 3 - 1 / (3 * m)) := by + have hm : 0 < m := NeZero.pos m + have hmR : (1 : ℝ) ≤ m := by exact_mod_cast hm + have hm3 : (0 : ℝ) < 3 * m := by linarith + have hc : (4 : ℝ) / 3 - 1 / (3 * m) = (4 * m - 1) / (3 * m) := by field_simp + have hn0 : 0 < n := by omega + refine ⟨?_, ?_⟩ + · rw [mem_upperBounds] + rintro r ⟨p, σ, hp, hσ, rfl⟩ + have hopt := fc_optMakespan_pos (m := m) hn0 p hp + rw [div_le_iff₀ hopt] + exact lpt_le_optMakespan_internal p (fun j => (hp j).le) σ hσ + · rw [mem_lowerBounds] + intro b hb + rw [mem_upperBounds] at hb + by_contra hlt + have hlt' : b < 4 / 3 - 1 / (3 * m) := lt_of_not_ge hlt + rw [hc, lt_div_iff₀ hm3] at hlt' + obtain ⟨D, hD⟩ : ∃ D : ℝ, D = 4 * m - 1 - 3 * m * b := ⟨_, rfl⟩ + have hDpos : 0 < D := by rw [hD]; linarith + have hbn : 0 ≤ |b| * n := mul_nonneg (abs_nonneg b) (Nat.cast_nonneg n) + have hden : 0 < D + |b| * n + 1 := by linarith only [hDpos, hbn] + obtain ⟨ε, hε⟩ : ∃ ε : ℝ, ε = D / (D + |b| * n + 1) := ⟨_, rfl⟩ + have hε0 : 0 < ε := by rw [hε]; exact div_pos hDpos hden + have hε1 : ε ≤ 1 := by rw [hε, div_le_one hden]; linarith only [hbn] + have hεm : ε ≤ m := by linarith only [hε1, hmR] + have hεeq : ε * (D + |b| * n + 1) = D := by rw [hε]; exact div_mul_cancel₀ D hden.ne' + obtain ⟨σ, hσ⟩ := exists_isLPTSchedule_internal (m := m) (paddedJobs m n ε) + have hpos : ∀ j, 0 < paddedJobs m n ε j := fc_jobs_pos m n ε hm hε0 + have hmem := hb _ ⟨paddedJobs m n ε, σ, hpos, hσ, rfl⟩ + have hopt := fc_optMakespan_pos (m := m) hn0 _ hpos + have hC := fc_le_makespan_lpt m n ε hε0 hεm hn σ hσ + have hoptle := fc_optMakespan_le m n ε hε0.le hn + rw [div_le_iff₀ hopt] at hmem + have hkey : b * optMakespan m (paddedJobs m n ε) < 4 * m - 1 := by + rcases le_or_gt b 0 with hb0 | hb0 + · have h1 : b * optMakespan m (paddedJobs m n ε) ≤ 0 := + mul_nonpos_of_nonpos_of_nonneg hb0 hopt.le + linarith only [h1, hmR] + · have h1 : b * optMakespan m (paddedJobs m n ε) ≤ b * (3 * m + n * ε) := + mul_le_mul_of_nonneg_left hoptle hb0.le + have h2 : |b| = b := abs_of_pos hb0 + rw [h2] at hεeq + have h3 : b * n * ε < D := by + nlinarith only [hεeq, hε0, mul_pos hε0 hDpos] + rw [hD] at h3 + nlinarith only [h1, h3] + linarith only [hC, hmem, hkey] + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/GrahamScaled.lean b/LeanPool/GrahamLPT/GrahamScaled.lean new file mode 100644 index 0000000000..0d42c10325 --- /dev/null +++ b/LeanPool/GrahamLPT/GrahamScaled.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +import LeanPool.GrahamLPT.Basic +import LeanPool.GrahamLPT.TightLPT +import Mathlib.Algebra.BigOperators.Ring.Finset +import Mathlib.Data.Rat.Floor +import Mathlib.Tactic.Positivity.Finset + +/-! +# GrahamScaled + +Scaling and relabeling of instances, and the sufficiency half of Dósa's theorem: every positive +multiple of Graham's instance in any order attains the bound. Helpers carry the prefix `gs_`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +/-- Scaling the lengths by `a ≥ 0` scales the loads before `k`. -/ +theorem gs_loadBefore_smul {m n : ℕ} (p : Fin n → ℝ) (a : ℝ) (σ : Fin n → Fin m) (k : ℕ) (i : Fin + m) : + loadBefore (fun j => a * p j) σ k i = a * loadBefore p σ k i := by + unfold loadBefore + rw [Finset.mul_sum] + +/-- Scaling the lengths by `a` scales every load. -/ +theorem gs_load_smul {m n : ℕ} (p : Fin n → ℝ) (a : ℝ) (σ : Fin n → Fin m) (i : Fin m) : + load (fun j => a * p j) σ i = a * load p σ i := by + unfold load + rw [Finset.mul_sum] + +/-- Scaling the lengths by `a ≥ 0` scales the makespan. -/ +theorem gs_makespan_smul {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (a : ℝ) (ha : 0 ≤ a) (σ : Fin n → + Fin m) : + makespan (fun j => a * p j) σ = a * makespan p σ := by + apply le_antisymm + · rw [bs_makespan_le_iff] + intro i + rw [gs_load_smul] + exact mul_le_mul_of_nonneg_left (bs_load_le_makespan p σ i) ha + · obtain ⟨i, hi⟩ := bs_exists_load_eq_makespan p σ + rw [← hi, ← gs_load_smul p a σ i] + exact bs_load_le_makespan _ σ i + +/-- Scaling the lengths by `a ≥ 0` scales the optimal makespan. -/ +theorem gs_optMakespan_smul {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (a : ℝ) (ha : 0 ≤ a) : + optMakespan m (fun j => a * p j) = a * optMakespan m p := by + apply le_antisymm + · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + rw [← hτ, ← gs_makespan_smul p a ha τ] + exact optMakespan_le_internal _ τ + · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) (fun j => a * p j) + rw [← hτ, gs_makespan_smul p a ha τ] + exact mul_le_mul_of_nonneg_left (optMakespan_le_internal p τ) ha + +/-- A list schedule of `p` is a list schedule of `a · p` for `a > 0`, and conversely. -/ +theorem gs_isListSchedule_smul_iff {m n : ℕ} (p : Fin n → ℝ) (a : ℝ) (ha : 0 < a) (σ : Fin n → Fin + m) : + IsListSchedule (fun j => a * p j) σ ↔ IsListSchedule p σ := by + unfold IsListSchedule + constructor + · intro h k i + have hki := h k i + rw [gs_loadBefore_smul, gs_loadBefore_smul] at hki + exact le_of_mul_le_mul_left hki ha + · intro h k i + rw [gs_loadBefore_smul, gs_loadBefore_smul] + exact mul_le_mul_of_nonneg_left (h k i) ha.le + +/-- Relabeling the jobs by a permutation preserves the optimal makespan. -/ +theorem gs_optMakespan_comp {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (π : Equiv.Perm (Fin n)) : + optMakespan m (p ∘ π) = optMakespan m p := by + apply le_antisymm + · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + rw [← hτ, ← makespan_comp_internal p τ π] + exact optMakespan_le_internal _ (τ ∘ π) + · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) (p ∘ π) + have hp : (p ∘ π) ∘ π.symm = p := by + funext j + simp only [Function.comp_apply, Equiv.apply_symm_apply] + have h := makespan_comp_internal (p ∘ π) τ π.symm + rw [hp] at h + rw [← hτ, ← h] + exact optMakespan_le_internal _ (τ ∘ π.symm) + +/-- Every positive multiple of Graham's instance, in any order, attains the bound: every LPT +schedule `σ` satisfies +`3m · C(σ) = (4m − 1) · optMakespan`. -/ +theorem lpt_eq_bound_of_graham_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (a : ℝ) (ha : 0 < a) + (e : Fin n ≃ Fin (2 * m + 1)) (he : ∀ j, p j = a * grahamJobs m (e j)) (σ : Fin n → Fin m) + (hσ : IsLPTSchedule p σ) : 3 * m * makespan p σ = (4 * m - 1) * optMakespan m p := by + have hn : n = 2 * m + 1 := by + have h := Fintype.card_congr e + simpa only [Fintype.card_fin] using h + subst hn + obtain ⟨π, hanti, hls⟩ := hσ + have hpe : p = fun j => a * (grahamJobs m ∘ e) j := funext he + have hpπ : p ∘ π = fun j => a * (grahamJobs m ∘ (π.trans e)) j := by + funext j + simp only [Function.comp_apply, Equiv.trans_apply, he] + have hanti' : Antitone (grahamJobs m ∘ (π.trans e)) := by + intro x y hxy + have h := hanti hxy + rw [hpπ] at h + exact le_of_mul_le_mul_left h ha + have hls' : IsListSchedule (grahamJobs m ∘ (π.trans e)) (σ ∘ π) := by + rw [hpπ] at hls + exact (gs_isListSchedule_smul_iff _ a ha _).1 hls + have hcomp : (σ ∘ e.symm) ∘ (π.trans e) = σ ∘ π := by + funext j + simp only [Function.comp_apply, Equiv.trans_apply, Equiv.symm_apply_apply] + have hlpt : IsLPTSchedule (grahamJobs m) (σ ∘ e.symm) := + ⟨π.trans e, hanti', by rw [hcomp]; exact hls'⟩ + have h1 : makespan (grahamJobs m) (σ ∘ e.symm) = 4 * m - 1 := + grahamJobs_lpt_makespan_internal m _ hlpt + have h2 : makespan p σ = a * makespan (grahamJobs m) (σ ∘ e.symm) := by + have hσe : (σ ∘ e.symm) ∘ e = σ := by + funext j + simp only [Function.comp_apply, Equiv.symm_apply_apply] + rw [hpe, gs_makespan_smul (grahamJobs m ∘ e) a ha.le σ, + ← makespan_comp_internal (grahamJobs m) (σ ∘ e.symm) e, hσe] + have h3 : optMakespan m p = a * (3 * m) := by + rw [hpe, gs_optMakespan_smul (grahamJobs m ∘ e) a ha.le, gs_optMakespan_comp (grahamJobs m) e, + grahamJobs_optMakespan_internal] + rw [h2, h3, h1] + ring + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/Imports.lean b/LeanPool/GrahamLPT/Imports.lean new file mode 100644 index 0000000000..386198bc38 --- /dev/null +++ b/LeanPool/GrahamLPT/Imports.lean @@ -0,0 +1,27 @@ +/- +Copyright (c) 2026 Lean Pool contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Lean Pool contributors +-/ +module -- shake: keep-all --deprecated_module: ignore + +-- Generated project imports; run `lake exe mk_all`. +public import LeanPool.GrahamLPT +public import LeanPool.GrahamLPT.Basic +public import LeanPool.GrahamLPT.Certificates +public import LeanPool.GrahamLPT.CoffmanSethi +public import LeanPool.GrahamLPT.Contracts +public import LeanPool.GrahamLPT.Counter +public import LeanPool.GrahamLPT.Defs +public import LeanPool.GrahamLPT.Equality +public import LeanPool.GrahamLPT.FixedCount +public import LeanPool.GrahamLPT.GrahamScaled +public import LeanPool.GrahamLPT.Key +public import LeanPool.GrahamLPT.LPTBound +public import LeanPool.GrahamLPT.LPTForm +public import LeanPool.GrahamLPT.ListBound +public import LeanPool.GrahamLPT.ListOptimum +public import LeanPool.GrahamLPT.OptList +public import LeanPool.GrahamLPT.Ratio +public import LeanPool.GrahamLPT.TightLPT +public import LeanPool.GrahamLPT.TightList diff --git a/LeanPool/GrahamLPT/Key.lean b/LeanPool/GrahamLPT/Key.lean new file mode 100644 index 0000000000..66a654733e --- /dev/null +++ b/LeanPool/GrahamLPT/Key.lean @@ -0,0 +1,211 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +import LeanPool.GrahamLPT.Basic +import Mathlib.Algebra.BigOperators.Group.Finset.Piecewise +import Mathlib.Algebra.Order.Archimedean.Real.Basic +import Mathlib.Tactic.Positivity.Finset + +/-! +# Key + +The key lemma by counting, and the optimality of LPT when every job exceeds a third of the optimum. +Helpers carry the prefix `key_`; the `_internal` twins of the Challenge theorems are closed in +`Contracts.lean`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +/-- Jobs of index at most `k` are at least `p k` long, so a set of them sums to at least its size +times `p k`. -/ +theorem key_card_mul_le_sum {n : ℕ} (p : Fin n → ℝ) (hanti : Antitone p) (k : Fin n) (U : Finset + (Fin n)) + (hU : ∀ j ∈ U, (j : ℕ) < (k : ℕ) + 1) : (U.card : ℝ) * p k ≤ ∑ j ∈ U, p j := by + have h : ∑ _j ∈ U, p k ≤ ∑ j ∈ U, p j := by + apply Finset.sum_le_sum + intro j hj + apply hanti + have := hU j hj + exact Fin.le_iff_val_le_val.mpr (by omega) + simpa [Finset.sum_const, nsmul_eq_mul] using h + +/-- The key lemma (PROOF.md §3): `p` nonincreasing and nonnegative, `σ` a list schedule, `τ` any +assignment +whose loads from the jobs of index `≤ k` are at most `T`, and `T < 3 p_k`: then the machine of `k` +ends by `T`. -/ +theorem key_lemma {m n : ℕ} (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : Antitone p) (σ : Fin n → + Fin m) + (hσ : IsListSchedule p σ) (k : Fin n) (τ : Fin n → Fin m) (T : ℝ) + (hT : ∀ i, loadBefore p τ (k + 1) i ≤ T) (h3 : T < 3 * p k) : + loadBefore p σ k (σ k) + p k ≤ T := by + classical + by_contra hcon + have hlt : T < loadBefore p σ k (σ k) + p k := lt_of_not_ge hcon + have hpk : 0 ≤ p k := hp k + have hL0 : 0 ≤ loadBefore p σ k (σ k) := Finset.sum_nonneg (fun j _ => hp j) + obtain ⟨E, hEdef⟩ : ∃ E : Fin m → Finset (Fin n), + E = fun i => univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) ∧ σ j = i) := ⟨_, rfl⟩ + obtain ⟨F, hFdef⟩ : ∃ F : Fin m → Finset (Fin n), + F = fun i => univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1 ∧ τ j = i) := ⟨_, rfl⟩ + obtain ⟨B, hBdef⟩ : ∃ B : Finset (Fin n), + B = univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1 ∧ loadBefore p σ k (σ k) ≤ p j) := + ⟨_, rfl⟩ + have hE : ∀ i, ∑ j ∈ E i, p j = loadBefore p σ k i := by intro i; rw [hEdef]; rfl + have hF : ∀ i, ∑ j ∈ F i, p j ≤ T := by intro i; rw [hFdef]; exact hT i + have hmemE : ∀ i j, j ∈ E i ↔ (j : ℕ) < (k : ℕ) ∧ σ j = i := by intro i j; rw [hEdef]; simp + have hmemF : ∀ i j, j ∈ F i ↔ (j : ℕ) < (k : ℕ) + 1 ∧ τ j = i := by intro i j; rw [hFdef]; simp + have hmemB : ∀ j, j ∈ B ↔ (j : ℕ) < (k : ℕ) + 1 ∧ loadBefore p σ k (σ k) ≤ p j := by + intro j; rw [hBdef]; simp + -- at most two jobs per `τ`-fiber + have hb2 : ∀ i, (F i).card ≤ 2 := by + intro i + by_contra h + have h3n : 3 ≤ (F i).card := by omega + have h3' : (3 : ℝ) ≤ ((F i).card : ℝ) := by exact_mod_cast h3n + have h1 := key_card_mul_le_sum p hanti k (F i) (fun j hj => ((hmemF i j).mp hj).1) + have h2 := hF i + nlinarith + -- (a) every machine has a `σ`-job before `k` + have ha1 : ∀ i, 1 ≤ (E i).card := by + intro i + by_contra h + have h0 : E i = ∅ := Finset.card_eq_zero.mp (by omega) + have hl : loadBefore p σ k i = 0 := by rw [← hE i, h0, Finset.sum_empty] + have hle := hσ k i + have hkF : k ∈ F (τ k) := (hmemF _ _).mpr ⟨by omega, rfl⟩ + have h1 := Finset.single_le_sum (fun j _ => hp j) hkF + have h2 := hF (τ k) + linarith + -- (c) a long job is alone on its `τ`-machine among the jobs up to `k` + have hB1 : ∀ j ∈ B, ∀ j' : Fin n, (j' : ℕ) < (k : ℕ) + 1 → τ j' = τ j → j' = j := by + intro j hj j' hj' hτ + by_contra hne + have hjB := (hmemB j).mp hj + have hsub : ({j, j'} : Finset (Fin n)) ⊆ F (τ j) := by + intro x hx + rcases Finset.mem_insert.mp hx with rfl | hx + · exact (hmemF _ _).mpr ⟨hjB.1, rfl⟩ + · rw [Finset.mem_singleton.mp hx]; exact (hmemF _ _).mpr ⟨hj', hτ⟩ + have h1 := Finset.sum_le_sum_of_subset_of_nonneg hsub (fun x _ _ => hp x) + rw [Finset.sum_pair (fun h => hne h.symm)] at h1 + have hpj' : p k ≤ p j' := hanti (Fin.le_iff_val_le_val.mpr (by omega)) + have h2 := hF (τ j) + linarith [hjB.2] + have hinj : Set.InjOn τ (B : Set (Fin n)) := by + intro j hj j' hj' h + exact (hB1 j (Finset.mem_coe.mp hj) j' ((hmemB j').mp (Finset.mem_coe.mp hj')).1 h.symm).symm + have hRcard : (B.image τ).card = B.card := Finset.card_image_of_injOn hinj + have hbR : ∀ i, (F i).card + (if i ∈ B.image τ then 1 else 0) ≤ 2 := by + intro i + split_ifs with hi + · obtain ⟨j, hj, rfl⟩ := Finset.mem_image.mp hi + have hsub : F (τ j) ⊆ {j} := by + intro j' hj' + have h' := (hmemF _ _).mp hj' + exact Finset.mem_singleton.mpr (hB1 j hj j' h'.1 h'.2) + have := Finset.card_le_card hsub + rw [Finset.card_singleton] at this + omega + · have := hb2 i; omega + have haS : ∀ i, 2 ≤ (E i).card + (if (E i).card = 1 then 1 else 0) := by + intro i + have := ha1 i + split_ifs with h <;> omega + -- (d) a machine with a single `σ`-job before `k` holds a long job + have hSsub : univ.filter (fun i => (E i).card = 1) ⊆ B.image σ := by + intro i hi + have h1 : (E i).card = 1 := (Finset.mem_filter.mp hi).2 + obtain ⟨j, hj⟩ := Finset.card_eq_one.mp h1 + have hjE : j ∈ E i := by rw [hj]; exact Finset.mem_singleton_self j + have hjm := (hmemE i j).mp hjE + have hsum : loadBefore p σ k i = p j := by rw [← hE i, hj, Finset.sum_singleton] + have hle := hσ k i + exact Finset.mem_image.mpr ⟨j, (hmemB j).mpr ⟨by omega, by linarith⟩, hjm.2⟩ + have hSc : (univ.filter (fun i => (E i).card = 1)).card ≤ B.card := + (Finset.card_le_card hSsub).trans Finset.card_image_le + -- (b) the fiber counts + obtain ⟨A, hAdef⟩ : ∃ A : Finset (Fin n), A = univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ)) + := ⟨_, rfl⟩ + obtain ⟨A', hA'def⟩ : ∃ A' : Finset (Fin n), + A' = univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1) := ⟨_, rfl⟩ + have hAA' : A' = insert k A := by + ext j + rw [hA'def, hAdef] + simp only [Finset.mem_filter, Finset.mem_univ, true_and, Finset.mem_insert, Fin.ext_iff] + omega + have hkA : k ∉ A := by rw [hAdef]; simp + have hA'card : A'.card = A.card + 1 := by rw [hAA', Finset.card_insert_of_notMem hkA] + have hsumA : A.card = ∑ i, (E i).card := by + rw [Finset.card_eq_sum_card_fiberwise (f := σ) (t := univ) + (fun _ _ => Finset.mem_coe.mpr (Finset.mem_univ _))] + refine Finset.sum_congr rfl (fun i _ => ?_) + rw [hAdef, hEdef, Finset.filter_filter] + have hsumA' : A'.card = ∑ i, (F i).card := by + rw [Finset.card_eq_sum_card_fiberwise (f := τ) (t := univ) + (fun _ _ => Finset.mem_coe.mpr (Finset.mem_univ _))] + refine Finset.sum_congr rfl (fun i _ => ?_) + rw [hA'def, hFdef, Finset.filter_filter] + have hsumE : 2 * m ≤ ∑ i, (E i).card + (univ.filter (fun i => (E i).card = 1)).card := by + have h := Finset.sum_le_sum (fun i (_ : i ∈ (univ : Finset (Fin m))) => haS i) + rw [Finset.sum_add_distrib, ← Finset.card_filter, Finset.sum_const, Finset.card_univ, + Fintype.card_fin, + smul_eq_mul] at h + omega + have hsumF : ∑ i, (F i).card + (B.image τ).card ≤ 2 * m := by + have h := Finset.sum_le_sum (fun i (_ : i ∈ (univ : Finset (Fin m))) => hbR i) + rw [Finset.sum_add_distrib, ← Finset.card_filter, Finset.filter_univ_mem, Finset.sum_const, + Finset.card_univ, + Fintype.card_fin, smul_eq_mul] at h + omega + omega + +/-- The sorted form of `lpt_optimal_of_third_lt`. -/ +theorem key_optimal_sorted {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : + Antitone p) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (τ : Fin n → Fin m) (h : ∀ j, makespan p τ < 3 * + p j) : + makespan p σ ≤ makespan p τ := by + rw [bs_makespan_le_iff] + intro i + by_cases hi : ∃ j, σ j = i + · obtain ⟨k, hk, hload⟩ := bs_exists_last_job p σ i hi + rw [hload] + subst hk + refine key_lemma p hp hanti σ hσ k τ (makespan p τ) (fun i' => ?_) (h k) + exact (bs_loadBefore_le_load p hp τ _ i').trans (load_le_makespan_internal p τ i') + · push Not at hi + rw [bs_load_eq_zero p σ i hi] + exact bs_makespan_nonneg p hp τ + +/-- When every job is longer than a third of the makespan of `τ`, every LPT schedule is at least +as good as `τ`. -/ +theorem lpt_optimal_of_third_lt_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (τ : Fin n → Fin m) + (h : ∀ j, makespan p τ < 3 * p j) : makespan p σ ≤ makespan p τ := by + obtain ⟨π, hπ, hlist⟩ := hσ + have hs := key_optimal_sorted (p ∘ π) (fun j => hp (π j)) hπ (σ ∘ π) hlist (τ ∘ π) + (fun j => by rw [makespan_comp_internal]; exact h (π j)) + rwa [makespan_comp_internal, makespan_comp_internal] at hs + +/-- LPT is optimal when every job is longer than a third of the optimal makespan. -/ +theorem lpt_eq_optMakespan_of_third_lt_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 + ≤ p j) + (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (h : ∀ j, optMakespan m p < 3 * p j) : + makespan p σ = optMakespan m p := by + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + apply le_antisymm + · rw [← hτ] + exact lpt_optimal_of_third_lt_internal p hp σ hσ τ (fun j => by rw [hτ]; exact h j) + · exact optMakespan_le_internal p σ + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/LPTBound.lean b/LeanPool/GrahamLPT/LPTBound.lean new file mode 100644 index 0000000000..c4e3346fd9 --- /dev/null +++ b/LeanPool/GrahamLPT/LPTBound.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +import LeanPool.GrahamLPT.Basic +import LeanPool.GrahamLPT.Key +import Mathlib.Algebra.Order.Archimedean.Real.Basic +import Mathlib.Tactic.Positivity.Finset + +/-! +# LPTBound + +Graham's 1969 bound for LPT. +Helpers carry the prefix `lb2_`; the `_internal` twins of the Challenge theorems are closed in +`Contracts.lean`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +/-- The sorted form of `lpt_bound`. -/ +theorem lb2_bound_sorted {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : + Antitone p) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (τ : Fin n → Fin m) : + 3 * (m : ℝ) * makespan p σ ≤ (4 * m - 1) * makespan p τ := by + have hm : (1 : ℝ) ≤ m := by + have := NeZero.ne m + exact_mod_cast Nat.one_le_iff_ne_zero.mpr this + have hτ0 : 0 ≤ makespan p τ := bs_makespan_nonneg p hp τ + obtain ⟨i, hi⟩ := bs_exists_load_eq_makespan p σ + by_cases h : ∃ j, σ j = i + · obtain ⟨k, hk, hload⟩ := bs_exists_last_job p σ i h + have hC : makespan p σ = loadBefore p σ k (σ k) + p k := by rw [← hi, hload, hk] + rw [hC] + rcases le_or_gt (3 * p k) (makespan p τ) with h3 | h3 + · have h1 := bs_mul_loadBefore_le p σ hσ k + have h2 := bs_sum_filter_add_le p hp k + have h4 := sum_le_mul_makespan_internal p τ + have h5 := mul_nonneg (sub_nonneg.2 hm) (sub_nonneg.2 h3) + nlinarith + · have hkey := key_lemma p hp hanti σ hσ k τ (makespan p τ) + (fun i => (bs_loadBefore_le_load p hp τ _ i).trans (load_le_makespan_internal p τ i)) h3 + have h5 := mul_nonneg (sub_nonneg.2 hm) hτ0 + have hm0 : (0 : ℝ) ≤ m := by linarith + have h6 := mul_le_mul_of_nonneg_left hkey (by linarith : (0 : ℝ) ≤ 3 * m) + nlinarith + · push Not at h + have h0 : makespan p σ = 0 := by rw [← hi]; exact bs_load_eq_zero p σ i h + rw [h0, mul_zero] + exact mul_nonneg (by linarith) hτ0 + +/-- Graham's bound for LPT: for nonnegative lengths, every LPT schedule `σ` and every assignment +`τ` satisfy +`3m · C(σ) ≤ (4m − 1) · C(τ)`. -/ +theorem lpt_bound_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (τ : Fin n → Fin m) : + 3 * (m : ℝ) * makespan p σ ≤ (4 * m - 1) * makespan p τ := by + obtain ⟨π, hanti, hl⟩ := hσ + have h := lb2_bound_sorted (p ∘ π) (fun j => hp _) hanti (σ ∘ π) hl (τ ∘ π) + rwa [makespan_comp_internal, makespan_comp_internal] at h + +/-- Every LPT schedule is within the factor `4/3 − 1/(3m)` of the optimum. -/ +theorem lpt_le_optMakespan_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) : + makespan p σ ≤ (4 / 3 - 1 / (3 * m)) * optMakespan m p := by + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + have h := lpt_bound_internal p hp σ hσ τ + rw [hτ] at h + have hm : (0 : ℝ) < m := by + have := NeZero.ne m + exact_mod_cast Nat.pos_of_ne_zero this + have heq : (4 / 3 - 1 / (3 * (m : ℝ))) * optMakespan m p = (4 * m - 1) * optMakespan m p / (3 * + m) := by + field_simp + rw [heq, le_div_iff₀ (by positivity)] + linarith + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/LPTForm.lean b/LeanPool/GrahamLPT/LPTForm.lean new file mode 100644 index 0000000000..3c0601ad5c --- /dev/null +++ b/LeanPool/GrahamLPT/LPTForm.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +import LeanPool.GrahamLPT.Basic +import LeanPool.GrahamLPT.Equality +import LeanPool.GrahamLPT.GrahamScaled +import LeanPool.GrahamLPT.LPTBound +import Mathlib.Data.Rat.Floor +import Mathlib.Tactic.Positivity.Finset + +/-! +# LPTForm + +Dósa's theorem for LPT schedules, the two-way statement, and the strict inequality for every job +count other than `2m + 1`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + + +/-- Dósa's theorem for LPT schedules: on `m ≥ 2` machines, an LPT schedule of a nonempty positive +instance attains Graham's +bound against the optimum only when the instance is a positive multiple of Graham's `2m + 1` jobs +in some order. -/ +theorem graham_of_lpt_eq_bound_internal {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p : Fin n + → ℝ) (hp : ∀ j, 0 < p j) + (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (heq : 3 * m * makespan p σ = (4 * m - 1) * + optMakespan m p) : + ∃ (a : ℝ) (e : Fin n ≃ Fin (2 * m + 1)), 0 < a ∧ ∀ j, p j = a * grahamJobs m (e j) := by + obtain ⟨π, hanti, hls⟩ := hσ + have heq' : 3 * m * makespan (p ∘ π) (σ ∘ π) = (4 * m - 1) * optMakespan m (p ∘ π) := by + rw [makespan_comp_internal, gs_optMakespan_comp] + exact heq + obtain ⟨a, h, ha, hpa⟩ := + graham_of_listSchedule_eq_bound_internal hm hn (p ∘ π) (fun j => hp (π j)) hanti (σ ∘ π) hls + heq' + refine ⟨a, π.symm.trans (finCongr h), ha, fun j => ?_⟩ + have hj := hpa (π.symm j) + simp only [Function.comp_apply, Equiv.apply_symm_apply] at hj + exact hj + +/-- Graham's example is the only tight one (Dósa 2004): for a nonempty positive instance on `m ≥ +2` machines, some LPT +schedule attains Graham's bound `3m · C(σ) = (4m − 1) · optMakespan` if and only if the instance +is a positive +multiple of Graham's `2m + 1` jobs in some order (and then every LPT schedule attains it, +`lpt_eq_bound_of_graham`). -/ +theorem lpt_eq_bound_iff_graham_internal {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p : Fin n + → ℝ) + (hp : ∀ j, 0 < p j) : + (∃ σ : Fin n → Fin m, IsLPTSchedule p σ ∧ 3 * m * makespan p σ = (4 * m - 1) * optMakespan m + p) ↔ + ∃ (a : ℝ) (e : Fin n ≃ Fin (2 * m + 1)), 0 < a ∧ ∀ j, p j = a * grahamJobs m (e j) := by + constructor + · rintro ⟨σ, hσ, heq⟩ + exact graham_of_lpt_eq_bound_internal hm hn p hp σ hσ heq + · rintro ⟨a, e, ha, he⟩ + obtain ⟨σ, hσ⟩ := exists_isLPTSchedule_internal (m := m) p + exact ⟨σ, hσ, lpt_eq_bound_of_graham_internal p a ha e he σ hσ⟩ + +/-- With any number of jobs other than `2m + 1`, no LPT schedule of a nonempty positive instance +on `m ≥ 2` machines attains +Graham's bound: the inequality is strict. -/ +theorem lpt_lt_bound_of_card_ne_internal {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (hn' : n ≠ + 2 * m + 1) + (p : Fin n → ℝ) (hp : ∀ j, 0 < p j) (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) : + 3 * m * makespan p σ < (4 * m - 1) * optMakespan m p := by + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + have hle := lpt_bound_internal p (fun j => (hp j).le) σ hσ τ + rw [hτ] at hle + refine lt_of_le_of_ne hle fun heq => hn' ?_ + obtain ⟨_, e, _, _⟩ := graham_of_lpt_eq_bound_internal hm hn p hp σ hσ heq + simpa using Fintype.card_congr e + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/ListBound.lean b/LeanPool/GrahamLPT/ListBound.lean new file mode 100644 index 0000000000..f4af0dc584 --- /dev/null +++ b/LeanPool/GrahamLPT/ListBound.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +import LeanPool.GrahamLPT.Basic +import Mathlib.Algebra.Order.Archimedean.Real.Basic +import Mathlib.Tactic.Positivity.Finset + +/-! +# ListBound + +Graham's 1966 bound for list scheduling. +Helpers carry the prefix `lb_`; the `_internal` twins of the Challenge theorems are closed in +`Contracts.lean`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +/-- The makespan of a list schedule, through the last job `k` of a heaviest machine: +`m · (L_k + p_k) ≤ Σ p + (m − 1) · p_k`. -/ +theorem lb_mul_le {m n : ℕ} (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : Fin n → Fin m) (hσ : + IsListSchedule p σ) + (k : Fin n) : (m : ℝ) * (loadBefore p σ k (σ k) + p k) ≤ ∑ j, p j + (m - 1) * p k := by + have h1 := bs_mul_loadBefore_le p σ hσ k + have h2 := bs_sum_filter_add_le p hp k + linarith + +/-- Graham's bound for list scheduling: for nonnegative lengths, every list schedule `σ` and every +assignment `τ` +satisfy `m · C(σ) ≤ (2m − 1) · C(τ)`. -/ +theorem listSchedule_bound_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (τ : Fin n → Fin m) : + (m : ℝ) * makespan p σ ≤ (2 * m - 1) * makespan p τ := by + have hm : (1 : ℝ) ≤ m := Nat.one_le_cast.mpr (NeZero.pos m) + have hτ0 := bs_makespan_nonneg p hp τ + obtain ⟨i, hi⟩ := bs_exists_load_eq_makespan p σ + by_cases h : ∃ j, σ j = i + · obtain ⟨k, hk, hload⟩ := bs_exists_last_job p σ i h + subst hk + have hmul := lb_mul_le p hp σ hσ k + have hsum := sum_le_mul_makespan_internal p τ + have hpk := le_makespan_of_nonneg_internal p hp τ k + have hpk' : ((m : ℝ) - 1) * p k ≤ ((m : ℝ) - 1) * makespan p τ := + mul_le_mul_of_nonneg_left hpk (by linarith) + rw [← hi, hload] + linarith + · push Not at h + have h0 := bs_load_eq_zero p σ i h + rw [← hi, h0, mul_zero] + exact mul_nonneg (by linarith) hτ0 + +/-- Every list schedule is within the factor `2 − 1/m` of the optimum. -/ +theorem listSchedule_le_optMakespan_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p + j) + (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) : + makespan p σ ≤ (2 - 1 / m) * optMakespan m p := by + have hm : (0 : ℝ) < m := Nat.cast_pos.mpr (NeZero.pos m) + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + have hb := listSchedule_bound_internal p hp σ hσ τ + rw [hτ] at hb + have heq : (2 - 1 / (m : ℝ)) * optMakespan m p = (2 * m - 1) * optMakespan m p / m := by + field_simp + rw [heq, le_div_iff₀ hm] + linarith + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/ListOptimum.lean b/LeanPool/GrahamLPT/ListOptimum.lean new file mode 100644 index 0000000000..66898fe9f0 --- /dev/null +++ b/LeanPool/GrahamLPT/ListOptimum.lean @@ -0,0 +1,228 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +import LeanPool.GrahamLPT.Basic +import Mathlib.Data.Fin.Tuple.Sort +import Mathlib.Data.Rat.Floor +import Mathlib.Tactic.Positivity.Finset + +/-! +# ListOptimum + +Graham's `ω₀` is the optimum: for nonnegative lengths every assignment `τ` is matched or improved +by a list schedule +(helpers carry the prefix `lo_`). The order is the start times of `τ` with each machine's jobs +run back to back in index order, `s j = loadBefore p τ j (τ j)`. In that order every list schedule +starts each job of +positive length no later than `τ` does (`lo_core`): if job `k` found every machine busy past `s +k`, each machine would +carry an earlier job running at time `s k`; those `m` jobs run at `s k` under `τ` too, on `m` +distinct machines of `τ`, +one of them `τ k`, which overlaps `k`. Hence every list-schedule load is at most `max_j (s j + p +j) ≤ makespan p τ`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +/-- A machine whose load before `k` exceeds `T ≥ 0` carries a job before `k` that is running at +time `T`. -/ +theorem lo_exists_cover {m n : ℕ} (q : Fin n → ℝ) (σ : Fin n → Fin m) (T : ℝ) (hT : 0 ≤ T) (i : + Fin m) : + ∀ k : ℕ, T < loadBefore q σ k i → + ∃ a : Fin n, (a : ℕ) < k ∧ σ a = i ∧ loadBefore q σ a i ≤ T ∧ T < loadBefore q σ a i + q a + := by + intro k + induction k with + | zero => + intro h + rw [bs_loadBefore_zero] at h + linarith + | succ k ih => + intro h + by_cases hk : T < loadBefore q σ k i + · obtain ⟨a, ha, h1, h2, h3⟩ := ih hk + exact ⟨a, by omega, h1, h2, h3⟩ + · have hk' : loadBefore q σ k i ≤ T := not_lt.mp hk + by_cases hkn : k < n + · have hs : loadBefore q σ (k + 1) i = + loadBefore q σ k i + if σ ⟨k, hkn⟩ = i then q ⟨k, hkn⟩ else 0 := + bs_loadBefore_succ q σ ⟨k, hkn⟩ i + by_cases hσk : σ ⟨k, hkn⟩ = i + · rw [hs, ite_eq_left hσk] at h + exact ⟨⟨k, hkn⟩, Nat.lt_succ_self k, hσk, hk', h⟩ + · rw [hs, ite_eq_right hσk] at h + linarith + · have e1 := bs_loadBefore_of_le q σ k (by omega) i + have e2 := bs_loadBefore_of_le q σ (k + 1) (by omega) i + linarith + +/-- In an order by nondecreasing times `t` that are the start times of a schedule `ρ` (no two jobs +of one machine of +`ρ` overlap), every list schedule starts each job of positive length no later than `ρ` does. -/ +theorem lo_core {m n : ℕ} (q : Fin n → ℝ) (σ : Fin n → Fin m) (hσ : IsListSchedule q σ) + (ρ : Fin n → Fin m) (t : Fin n → ℝ) (ht : Monotone t) (ht0 : ∀ j, 0 ≤ t j) + (hdisj : ∀ a b, a ≠ b → ρ a = ρ b → t a + q a ≤ t b ∨ t b + q b ≤ t a) : + ∀ N : ℕ, ∀ k : Fin n, (k : ℕ) < N → 0 < q k → loadBefore q σ k (σ k) ≤ t k := by + intro N + induction N with + | zero => + intro k hk + omega + | succ N ih => + intro k hkN hqk + by_contra hcon + have hcon' : t k < loadBefore q σ k (σ k) := lt_of_not_ge hcon + have hall : ∀ i, t k < loadBefore q σ k i := fun i => lt_of_lt_of_le hcon' (hσ k i) + have hcov : ∀ i, ∃ a : Fin n, (a : ℕ) < k ∧ σ a = i ∧ loadBefore q σ a i ≤ t k ∧ + t k < loadBefore q σ a i + q a := + fun i => lo_exists_cover q σ (t k) (ht0 k) i k (hall i) + choose f hfk hfσ hf1 hf2 using hcov + have hend : ∀ i, t k < t (f i) + q (f i) := by + intro i + have hpos : 0 < q (f i) := by linarith [hf1 i, hf2 i] + have hL := ih (f i) (by have := hfk i; omega) hpos + rw [hfσ i] at hL + linarith [hf2 i] + have hle : ∀ i, t (f i) ≤ t k := fun i => ht (Fin.le_iff_val_le_val.2 (Nat.le_of_lt (hfk i))) + have hinj : Function.Injective (ρ ∘ f) := by + intro i i' h + by_contra hne + have hab : f i ≠ f i' := by + intro e + apply hne + rw [← hfσ i, ← hfσ i', e] + rcases hdisj (f i) (f i') hab h with h1 | h1 + · linarith [hend i, hle i'] + · linarith [hend i', hle i] + obtain ⟨i, hi⟩ := Finite.injective_iff_surjective.mp hinj (ρ k) + have hne : f i ≠ k := by + intro e + have := hfk i + rw [e] at this + omega + rcases hdisj (f i) k hne hi with h1 | h1 + · linarith [hend i] + · linarith [hle i] + +/-- Every list schedule in such an order has makespan at most any bound `C ≥ 0` on the completion +times `t j + q j`. -/ +theorem lo_makespan_le {m n : ℕ} [NeZero m] (q : Fin n → ℝ) (hq : ∀ j, 0 ≤ q j) (σ : Fin n → Fin m) + (hσ : IsListSchedule q σ) (ρ : Fin n → Fin m) (t : Fin n → ℝ) (ht : Monotone t) (ht0 : ∀ j, 0 + ≤ t j) + (hdisj : ∀ a b, a ≠ b → ρ a = ρ b → t a + q a ≤ t b ∨ t b + q b ≤ t a) (C : ℝ) (hC0 : 0 ≤ C) + (hC : ∀ j, t j + q j ≤ C) : makespan q σ ≤ C := by + have key := lo_core q σ hσ ρ t ht ht0 hdisj n + have hstep : ∀ k : ℕ, ∀ i, loadBefore q σ k i ≤ C := by + intro k + induction k with + | zero => + intro i + rw [bs_loadBefore_zero] + exact hC0 + | succ k ih => + intro i + by_cases hkn : k < n + · have hs : loadBefore q σ (k + 1) i = + loadBefore q σ k i + if σ ⟨k, hkn⟩ = i then q ⟨k, hkn⟩ else 0 := + bs_loadBefore_succ q σ ⟨k, hkn⟩ i + rw [hs] + by_cases hσk : σ ⟨k, hkn⟩ = i + · rw [ite_eq_left hσk] + rcases (hq ⟨k, hkn⟩).lt_or_eq with hpos | hzero + · have h1 : loadBefore q σ k (σ ⟨k, hkn⟩) ≤ t ⟨k, hkn⟩ := key ⟨k, hkn⟩ hkn hpos + rw [hσk] at h1 + linarith [hC ⟨k, hkn⟩] + · rw [← hzero] + linarith [ih i] + · rw [ite_eq_right hσk] + linarith [ih i] + · rw [bs_loadBefore_of_le q σ (k + 1) (by omega) i, ← bs_loadBefore_of_le q σ k (by omega) i] + exact ih i + rw [bs_makespan_le_iff] + intro i + rw [← bs_loadBefore_of_le q σ n le_rfl i] + exact hstep n i + +/-- Graham's `ω₀` is attained: for nonnegative lengths every assignment `τ` is matched or improved +by a list schedule +in some order (the jobs listed by their start times when each machine of `τ` runs its jobs in +index order). -/ +theorem lo_exists_listSchedule_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (τ : Fin n → Fin m) : + ∃ (π : Equiv.Perm (Fin n)) (σ : Fin n → Fin m), + IsListSchedule (p ∘ π) (σ ∘ π) ∧ makespan p σ ≤ makespan p τ := by + obtain ⟨s, hs⟩ : ∃ s : Fin n → ℝ, s = fun j : Fin n => loadBefore p τ j (τ j) := ⟨_, rfl⟩ + have hsucc : ∀ j : Fin n, s j + p j = loadBefore p τ ((j : ℕ) + 1) (τ j) := by + intro j + rw [hs, bs_loadBefore_succ, ite_eq_left rfl] + have hs0 : ∀ j, 0 ≤ s j := by + intro j + rw [hs] + exact Finset.sum_nonneg fun j' _ => hp j' + have hone : ∀ a b : Fin n, a < b → τ a = τ b → s a + p a ≤ s b := by + intro a b hab he + rw [hsucc a, hs] + change loadBefore p τ (a + 1) (τ a) ≤ loadBefore p τ b (τ b) + rw [← he] + exact bs_loadBefore_mono p hp τ (Fin.lt_def.1 hab) (τ a) + have hdisj : ∀ a b : Fin n, a ≠ b → τ a = τ b → s a + p a ≤ s b ∨ s b + p b ≤ s a := by + intro a b hab he + rcases lt_or_gt_of_ne hab with h | h + · exact Or.inl (hone a b h he) + · exact Or.inr (hone b a h he.symm) + have hC : ∀ j, s j + p j ≤ makespan p τ := by + intro j + rw [hsucc j] + exact (bs_loadBefore_le_load p hp τ _ _).trans (bs_load_le_makespan p τ _) + set π := Tuple.sort s with hπ + have hmono : Monotone (s ∘ π) := Tuple.monotone_sort s + obtain ⟨σ', hσ'⟩ := exists_isListSchedule_internal (m := m) (p ∘ π) + have e : (σ' ∘ ⇑π.symm) ∘ ⇑π = σ' := by + funext j + simp + refine ⟨π, σ' ∘ π.symm, ?_, ?_⟩ + · rw [e] + exact hσ' + · have key := lo_makespan_le (p ∘ π) (fun j => hp (π j)) σ' hσ' (τ ∘ π) (s ∘ π) hmono + (fun j => hs0 (π j)) (fun a b hab he => hdisj (π a) (π b) (π.injective.ne hab) he) + (makespan p τ) (bs_makespan_nonneg p hp τ) (fun j => hC (π j)) + rw [← makespan_comp_internal p (σ' ∘ π.symm) π, e] + exact key + +/-- The optimal makespan is the least makespan over the list schedules in all orders (Graham's +`ω₀` equals `optMakespan`). -/ +theorem lo_optMakespan_eq {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) : + IsLeast ((fun σ : Fin n → Fin m => makespan p σ) '' + {σ | ∃ π : Equiv.Perm (Fin n), IsListSchedule (p ∘ π) (σ ∘ π)}) (optMakespan m p) := by + constructor + · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + obtain ⟨π, σ, hσ, hle⟩ := lo_exists_listSchedule_le p hp τ + refine ⟨σ, ⟨π, hσ⟩, le_antisymm ?_ (optMakespan_le_internal p σ)⟩ + rw [← hτ] + exact hle + · rintro c ⟨σ, -, rfl⟩ + exact optMakespan_le_internal p σ + +theorem exists_listSchedule_le_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (τ : Fin n → Fin m) : + ∃ (π : Equiv.Perm (Fin n)) (σ : Fin n → Fin m), + IsListSchedule (p ∘ π) (σ ∘ π) ∧ makespan p σ ≤ makespan p τ := + lo_exists_listSchedule_le p hp τ + +theorem isLeast_listSchedule_makespan_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ + p j) : + IsLeast ((fun σ : Fin n → Fin m => makespan p σ) '' + {σ | ∃ π : Equiv.Perm (Fin n), IsListSchedule (p ∘ π) (σ ∘ π)}) (optMakespan m p) := + lo_optMakespan_eq p hp + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/OptList.lean b/LeanPool/GrahamLPT/OptList.lean new file mode 100644 index 0000000000..c756cbc3fd --- /dev/null +++ b/LeanPool/GrahamLPT/OptList.lean @@ -0,0 +1,228 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +import LeanPool.GrahamLPT.Basic +import Mathlib.Algebra.Order.Archimedean.Real.Basic +import Mathlib.Tactic.Positivity.Finset + +/-! +# OptList + +The order `grahamOrder` of Graham's family, its lengths, and the optimum attained by a list +schedule in that order. +Helpers carry the prefix `ol_`; the `_internal` twins of the Challenge theorems are closed in +`Contracts.lean`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +/-- The order `grahamOrder m` is a permutation of the `2m + 1` jobs. -/ +theorem grahamOrder_bijective_internal (m : ℕ) : Function.Bijective (grahamOrder m) := by + rw [← Finite.injective_iff_bijective] + intro a b h + have ha := a.isLt + have hb := b.isLt + simp only [grahamOrder] at h + rw [Fin.ext_iff] + split_ifs at h <;> simp only [Fin.mk.injEq] at h <;> omega + +/-- The machine of each position, as a natural number: `i` for `i < m − 1`; the last machine `m − +1` for positions +`m − 1`, `m` and `2m`; `2m − 1 − i` (that is, `m − 2 − a`) for position `m + 1 + a`. -/ +def optimalMachineIndex (m i : ℕ) : ℕ := + if i < m - 1 then i else if i ≤ m then m - 1 else if i < 2 * m then 2 * m - 1 - i else m - 1 + +/-- The machine of each position: `i` for `i < m − 1`; the last machine for positions `m − 1`, `m` +and `2m`; +`m − 2 − a` (that is, `2m − 1 − i`) for position `i = m + 1 + a`, the least loaded one at that +step. -/ +def optimalMachine (m : ℕ) [NeZero m] (i : Fin (2 * m + 1)) : Fin m := + ⟨optimalMachineIndex m i, by have := NeZero.pos m; unfold optimalMachineIndex; split_ifs <;> + omega⟩ + +/-- The length of the job at each position, as a natural number. -/ +def orderedJobLength (m i : ℕ) : ℕ := + if i < m - 1 then 2 * m - 1 - i else if i ≤ m then m else if i < 2 * m then 3 * m - i else m + +/-- The load of machine `b` from the positions below `k`, as a natural number. -/ +def optimalPrefixLoad (m k b : ℕ) : ℕ := + if b < m - 1 then (if b < k then 2 * m - 1 - b else 0) + (if 2 * m - 1 - b < k then m + 1 + b + else 0) + else (if m - 1 < k then m else 0) + (if m < k then m else 0) + (if 2 * m < k then m else 0) + +theorem ol_q (m : ℕ) [NeZero m] (j : Fin (2 * m + 1)) : grahamJobs m (grahamOrder m j) = + (orderedJobLength m + j : ℝ) := by + have hj := j.isLt + have hm := NeZero.pos m + simp only [grahamOrder] + split_ifs with h₁ h₂ h₃ h₄ + · have hA : 2 * (j : ℕ) < 2 * m := by omega + have hc : (2 * (j : ℕ)) / 2 = j := by omega + simp only [grahamJobs, orderedJobLength, h₁, hA, hc, ite_true] + have : ((2 * m - 1 - j : ℕ) : ℝ) + (j : ℝ) + 1 = 2 * (m : ℝ) := by + exact_mod_cast (show 2 * m - 1 - (j : ℕ) + (j : ℕ) + 1 = 2 * m by omega) + linarith + · have hA : 2 * m - 2 < 2 * m := by omega + have hle : (j : ℕ) ≤ m := by omega + have hc : (2 * m - 2) / 2 = m - 1 := by omega + simp only [grahamJobs, orderedJobLength, h₁, hle, hA, hc, ite_true, ite_false] + have : ((m - 1 : ℕ) : ℝ) + 1 = (m : ℝ) := by exact_mod_cast (show m - 1 + 1 = m by omega) + linarith + · have hA : 2 * m - 1 < 2 * m := by omega + have hle : (j : ℕ) ≤ m := by omega + have hc : (2 * m - 1) / 2 = m - 1 := by omega + simp only [grahamJobs, orderedJobLength, h₁, hle, hA, hc, ite_true, ite_false] + have : ((m - 1 : ℕ) : ℝ) + 1 = (m : ℝ) := by exact_mod_cast (show m - 1 + 1 = m by omega) + linarith + · have hA : 2 * ((j : ℕ) - m - 1) + 1 < 2 * m := by omega + have hle : ¬ (j : ℕ) ≤ m := by omega + have hc : (2 * ((j : ℕ) - m - 1) + 1) / 2 = (j : ℕ) - m - 1 := by omega + simp only [grahamJobs, orderedJobLength, h₁, hle, h₄, hA, hc, ite_true, ite_false] + have : ((3 * m - j : ℕ) : ℝ) + (((j : ℕ) - m - 1 : ℕ) : ℝ) + 1 = 2 * (m : ℝ) := by + exact_mod_cast (show 3 * m - (j : ℕ) + ((j : ℕ) - m - 1) + 1 = 2 * m by omega) + linarith + · have hA : ¬ 2 * m < 2 * m := by omega + have hle : ¬ (j : ℕ) ≤ m := by omega + simp only [grahamJobs, orderedJobLength, h₁, hle, h₄, hA, ite_false] + +/-- The lengths of Graham's instance taken in the order `grahamOrder m` are +`2m − 1, …, m + 1, m, m, 2m − 1, …, m + 1, m`: position `i` holds length `2m − 1 − i` for `i < m − +1`, `m` for +`i = m − 1` and `i = m`, `3m − i` for `m < i < 2m`, and `m` for `i = 2m`. -/ +theorem grahamJobs_grahamOrder_internal (m : ℕ) (i : Fin (2 * m + 1)) : + grahamJobs m (grahamOrder m i) = + if (i : ℕ) < m - 1 then 2 * (m : ℝ) - 1 - ((i : ℕ) : ℝ) + else if (i : ℕ) ≤ m then (m : ℝ) + else if (i : ℕ) < 2 * m then 3 * (m : ℝ) - ((i : ℕ) : ℝ) + else (m : ℝ) := by + rcases Nat.eq_zero_or_pos m with rfl | hm + · simp [grahamJobs, grahamOrder] + · have : NeZero m := ⟨by omega⟩ + rw [ol_q] + unfold orderedJobLength + split_ifs with h₁ h₂ h₃ + · have : ((2 * m - 1 - i : ℕ) : ℝ) + ((i : ℕ) : ℝ) + 1 = 2 * (m : ℝ) := by + exact_mod_cast (show 2 * m - 1 - (i : ℕ) + (i : ℕ) + 1 = 2 * m by omega) + linarith + · rfl + · have : ((3 * m - i : ℕ) : ℝ) + ((i : ℕ) : ℝ) = 3 * (m : ℝ) := by + exact_mod_cast (show 3 * m - (i : ℕ) + (i : ℕ) = 3 * m by omega) + linarith + · rfl + +theorem ol_loadBefore (m : ℕ) [NeZero m] (k : ℕ) (b : Fin m) : + loadBefore (grahamJobs m ∘ grahamOrder m) (optimalMachine m) k b = (optimalPrefixLoad m k b : + ℝ) := by + have hm := NeZero.pos m + have hbm := b.isLt + by_cases hb : (b : ℕ) < m - 1 + · have hfib : univ.filter (fun j : Fin (2 * m + 1) => (j : ℕ) < k ∧ optimalMachine m j = b) = + ({⟨b, by omega⟩, ⟨2 * m - 1 - b, by omega⟩} : Finset (Fin (2 * m + 1))).filter + (fun j : Fin (2 * m + 1) => (j : ℕ) < k) := by + ext j + have hj := j.isLt + simp only [mem_filter, mem_univ, true_and, mem_insert, mem_singleton, Fin.ext_iff, + optimalMachine, + optimalMachineIndex] + split_ifs <;> omega + rw [loadBefore, hfib, sum_filter, sum_pair (by simp only [ne_eq, Fin.ext_iff]; omega)] + simp only [Function.comp_apply, ol_q] + have e1 : orderedJobLength m b = 2 * m - 1 - b := by + unfold orderedJobLength + rw [ite_eq_left hb] + have e2 : orderedJobLength m (2 * m - 1 - b) = m + 1 + b := by + unfold orderedJobLength + split_ifs <;> omega + rw [e1, e2] + unfold optimalPrefixLoad + rw [ite_eq_left hb] + split_ifs <;> push_cast [Nat.cast_add] <;> ring + · have hb' : (b : ℕ) = m - 1 := by omega + have hfib : univ.filter (fun j : Fin (2 * m + 1) => (j : ℕ) < k ∧ optimalMachine m j = b) = + ({⟨m - 1, by omega⟩, ⟨m, by omega⟩, ⟨2 * m, by omega⟩} : Finset (Fin (2 * m + 1))).filter + (fun j : Fin (2 * m + 1) => (j : ℕ) < k) := by + ext j + have hj := j.isLt + simp only [mem_filter, mem_univ, true_and, mem_insert, mem_singleton, Fin.ext_iff, + optimalMachine, + optimalMachineIndex] + split_ifs <;> omega + have hnot : (⟨m - 1, by omega⟩ : Fin (2 * m + 1)) ∉ ({⟨m, by omega⟩, ⟨2 * m, by omega⟩} : + Finset _) := by + simp only [mem_insert, mem_singleton, Fin.ext_iff] + omega + rw [loadBefore, hfib, sum_filter, sum_insert hnot, + sum_pair (by simp only [ne_eq, Fin.ext_iff]; omega)] + simp only [Function.comp_apply, ol_q] + have e1 : orderedJobLength m (m - 1) = m := by unfold orderedJobLength; split_ifs <;> omega + have e2 : orderedJobLength m m = m := by unfold orderedJobLength; split_ifs <;> omega + have e3 : orderedJobLength m (2 * m) = m := by unfold orderedJobLength; split_ifs <;> omega + rw [e1, e2, e3] + unfold optimalPrefixLoad + rw [ite_eq_right hb] + split_ifs <;> push_cast [Nat.cast_add] <;> ring + +theorem ol_listN (m k b : ℕ) (hk : k ≤ 2 * m) (hb : b < m) : + optimalPrefixLoad m k (optimalMachineIndex m k) ≤ optimalPrefixLoad m k b := by + unfold optimalPrefixLoad optimalMachineIndex + split_ifs <;> omega + +/-- In the order `grahamOrder m`, the schedule `optimalMachine` is a list schedule. -/ +theorem ol_isListSchedule (m : ℕ) [NeZero m] : + IsListSchedule (grahamJobs m ∘ grahamOrder m) (optimalMachine m) := by + intro k i + rw [ol_loadBefore, ol_loadBefore] + exact_mod_cast ol_listN m k i (by have := k.isLt; omega) i.isLt + +theorem ol_load (m : ℕ) [NeZero m] (b : Fin m) : + load (grahamJobs m ∘ grahamOrder m) (optimalMachine m) b = 3 * (m : ℝ) := by + rw [← bs_loadBefore_of_le _ _ (2 * m + 1) le_rfl, ol_loadBefore] + have hb := b.isLt + have : optimalPrefixLoad m (2 * m + 1) b = 3 * m := by unfold optimalPrefixLoad; split_ifs <;> + omega + rw [this] + push_cast + ring + +/-- Its makespan is `3m`. -/ +theorem ol_makespan (m : ℕ) [NeZero m] : + makespan (grahamJobs m ∘ grahamOrder m) (optimalMachine m) = 3 * m := by + apply le_antisymm + · rw [bs_makespan_le_iff] + intro i + rw [ol_load] + · rw [← ol_load m ⟨0, NeZero.pos m⟩] + exact load_le_makespan_internal _ _ _ + +/-- The optimum `3m` of Graham's instance is attained by a list schedule in the order `grahamOrder +m`, that is +`2m − 1, …, m + 1, m, m, 2m − 1, …, m + 1, m` (`grahamJobs_grahamOrder`): some assignment `σ` is a +list schedule of +the jobs taken in that order and has makespan `3m`. -/ +theorem grahamJobs_exists_optimal_listSchedule_internal (m : ℕ) [NeZero m] : + ∃ σ : Fin (2 * m + 1) → Fin m, + IsListSchedule (grahamJobs m ∘ grahamOrder m) (σ ∘ grahamOrder m) ∧ makespan (grahamJobs m) + σ = 3 * m := by + let π : Equiv.Perm (Fin (2 * m + 1)) := Equiv.ofBijective _ (grahamOrder_bijective_internal m) + have hπ : (π : Fin (2 * m + 1) → Fin (2 * m + 1)) = grahamOrder m := rfl + have hσ : (optimalMachine m ∘ π.symm) ∘ π = optimalMachine m := by + funext j + simp + refine ⟨optimalMachine m ∘ π.symm, ?_, ?_⟩ + · rw [← hπ, hσ, hπ] + exact ol_isListSchedule m + · rw [← makespan_comp_internal (grahamJobs m) (optimalMachine m ∘ π.symm) π, hσ, hπ] + exact ol_makespan m + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/Ratio.lean b/LeanPool/GrahamLPT/Ratio.lean new file mode 100644 index 0000000000..08470b740e --- /dev/null +++ b/LeanPool/GrahamLPT/Ratio.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +import LeanPool.GrahamLPT.Basic +import LeanPool.GrahamLPT.LPTBound +import LeanPool.GrahamLPT.ListBound +import LeanPool.GrahamLPT.TightLPT +import LeanPool.GrahamLPT.TightList +import Mathlib.Algebra.Order.Archimedean.Real.Basic +import Mathlib.Tactic.Positivity.Finset + +/-! +# Ratio + +The least constants, `2 − 1/m` and `4/3 − 1/(3m)`. +Helpers carry the prefix `rt_`; the `_internal` twins of the Challenge theorems are closed in +`Contracts.lean`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +/-- `2 − 1/m` is the least constant `c` with `C(σ) ≤ c · C(τ)` for every list schedule `σ` of every +nonnegative instance on `m` machines and every assignment `τ`. -/ +theorem isLeast_listSchedule_ratio_internal (m : ℕ) [NeZero m] : + IsLeast {c : ℝ | ∀ (n : ℕ) (p : Fin n → ℝ) (σ τ : Fin n → Fin m), (∀ j, 0 ≤ p j) → + IsListSchedule p σ → makespan p σ ≤ c * makespan p τ} (2 - 1 / m) := by + have hm : (0 : ℝ) < m := by exact_mod_cast Nat.pos_of_ne_zero (NeZero.ne m) + have hc : (2 : ℝ) - 1 / m = (2 * m - 1) / m := by field_simp + refine ⟨?_, ?_⟩ + · intro n p σ τ hp hσ + have h := listSchedule_bound_internal p hp σ hσ τ + rw [hc, div_mul_eq_mul_div, le_div_iff₀ hm] + linarith + · intro c hc' + obtain ⟨σ, hσ⟩ := exists_isListSchedule_internal (m := m) (unitJobs m) + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) (unitJobs m) + have h := hc' _ (unitJobs m) σ τ (tl_unitJobs_nonneg m) hσ + rw [unitJobs_listSchedule_makespan_internal m σ hσ, hτ, unitJobs_optMakespan_internal m] at h + rw [hc, div_le_iff₀ hm] + linarith + +/-- `4/3 − 1/(3m)` is the least constant `c` with `C(σ) ≤ c · C(τ)` for every LPT schedule `σ` of +every nonnegative +instance on `m` machines and every assignment `τ`. -/ +theorem isLeast_lpt_ratio_internal (m : ℕ) [NeZero m] : + IsLeast {c : ℝ | ∀ (n : ℕ) (p : Fin n → ℝ) (σ τ : Fin n → Fin m), (∀ j, 0 ≤ p j) → + IsLPTSchedule p σ → makespan p σ ≤ c * makespan p τ} (4 / 3 - 1 / (3 * m)) := by + have hm : (0 : ℝ) < m := by exact_mod_cast Nat.pos_of_ne_zero (NeZero.ne m) + have hm3 : (0 : ℝ) < 3 * m := by positivity + have hc : (4 : ℝ) / 3 - 1 / (3 * m) = (4 * m - 1) / (3 * m) := by field_simp + refine ⟨?_, ?_⟩ + · intro n p σ τ hp hσ + have h := lpt_bound_internal p hp σ hσ τ + rw [hc, div_mul_eq_mul_div, le_div_iff₀ hm3] + linarith + · intro c hc' + obtain ⟨σ, hσ⟩ := exists_isLPTSchedule_internal (m := m) (grahamJobs m) + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) (grahamJobs m) + have h := hc' _ (grahamJobs m) σ τ (tg_grahamJobs_nonneg m) hσ + rw [grahamJobs_lpt_makespan_internal m σ hσ, hτ, grahamJobs_optMakespan_internal m] at h + rw [hc, div_le_iff₀ hm3] + linarith + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/TightLPT.lean b/LeanPool/GrahamLPT/TightLPT.lean new file mode 100644 index 0000000000..e47327d300 --- /dev/null +++ b/LeanPool/GrahamLPT/TightLPT.lean @@ -0,0 +1,281 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +import LeanPool.GrahamLPT.Basic +import LeanPool.GrahamLPT.Key +import LeanPool.GrahamLPT.LPTBound +import Mathlib.Algebra.Order.Archimedean.Real.Basic +import Mathlib.Data.Fin.Tuple.Sort +import Mathlib.Data.Fintype.BigOperators +import Mathlib.Tactic.Positivity.Finset + +/-! +# TightLPT + +Graham's family: optimum `3m`, LPT makespan `4m − 1`. +Helpers carry the prefix `tg_`; the `_internal` twins of the Challenge theorems are closed in +`Contracts.lean`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +theorem tg_grahamJobs_apply_lt (m : ℕ) (j : Fin (2 * m + 1)) (h : (j : ℕ) < 2 * m) : + grahamJobs m j = 2 * (m : ℝ) - 1 - (((j : ℕ) / 2 : ℕ) : ℝ) := by + unfold grahamJobs + exact ite_eq_left h + +theorem tg_grahamJobs_apply_last (m : ℕ) (j : Fin (2 * m + 1)) (h : 2 * m ≤ (j : ℕ)) : grahamJobs + m j = m := by + unfold grahamJobs + exact ite_eq_right (by omega) + +theorem tg_le_grahamJobs (m : ℕ) (j : Fin (2 * m + 1)) : (m : ℝ) ≤ grahamJobs m j := by + by_cases h : (j : ℕ) < 2 * m + · rw [tg_grahamJobs_apply_lt m j h] + have h1 : (j : ℕ) / 2 + 1 ≤ m := by omega + have h2 : (((j : ℕ) / 2 : ℕ) : ℝ) + 1 ≤ (m : ℝ) := by exact_mod_cast h1 + linarith + · rw [tg_grahamJobs_apply_last m j (by omega)] + +theorem tg_grahamJobs_nonneg (m : ℕ) (j : Fin (2 * m + 1)) : 0 ≤ grahamJobs m j := + le_trans (Nat.cast_nonneg m) (tg_le_grahamJobs m j) + +/-- `Σ_{j < 2k} (c − ⌊j/2⌋) = 2kc − k(k − 1)`. -/ +theorem tg_sum_range_aux (c : ℝ) (k : ℕ) : + ∑ j ∈ range (2 * k), (c - ((j / 2 : ℕ) : ℝ)) = 2 * (k : ℝ) * c - (k : ℝ) * ((k : ℝ) - 1) := by + induction k with + | zero => simp + | succ k ih => + rw [show 2 * (k + 1) = 2 * k + 1 + 1 by ring, sum_range_succ, sum_range_succ, ih, + show (2 * k) / 2 = k by omega, show (2 * k + 1) / 2 = k by omega] + push_cast + ring + +theorem tg_grahamJobs_sum (m : ℕ) : ∑ j, grahamJobs m j = 3 * (m : ℝ) ^ 2 := by + have h1 : ∑ j, grahamJobs m j = ∑ j ∈ range (2 * m + 1), + (if j < 2 * m then 2 * (m : ℝ) - 1 - ((j / 2 : ℕ) : ℝ) else (m : ℝ)) := + Fin.sum_univ_eq_sum_range (fun j => if j < 2 * m then 2 * (m : ℝ) - 1 - ((j / 2 : ℕ) : ℝ) else + (m : ℝ)) + (2 * m + 1) + have h2 : ∑ j ∈ range (2 * m), + (if j < 2 * m then 2 * (m : ℝ) - 1 - ((j / 2 : ℕ) : ℝ) else (m : ℝ)) = + ∑ j ∈ range (2 * m), (2 * (m : ℝ) - 1 - ((j / 2 : ℕ) : ℝ)) := + sum_congr rfl fun j hj => ite_eq_left (mem_range.1 hj) + rw [h1, sum_range_succ, ite_eq_right (lt_irrefl _), h2, tg_sum_range_aux] + ring + +/-- The pairs `j, 2m − 1 − j` of the first `2m` jobs sum to `3m − 1`. -/ +theorem tg_pair (m : ℕ) (j : Fin (2 * m + 1)) (h : (j : ℕ) < 2 * m) : + grahamJobs m j + grahamJobs m ⟨2 * m - 1 - j, by omega⟩ = 3 * m - 1 := by + have key : ∀ a b : ℕ, a + b + 1 = m → + 2 * (m : ℝ) - 1 - (a : ℝ) + (2 * (m : ℝ) - 1 - (b : ℝ)) = 3 * m - 1 := by + intro a b hab + have : (a : ℝ) + b + 1 = m := by exact_mod_cast hab + linarith + rw [tg_grahamJobs_apply_lt m j h, tg_grahamJobs_apply_lt m ⟨2 * m - 1 - j, by omega⟩ + (by dsimp only; omega)] + exact key _ _ (by dsimp only; omega) + +/-- The pairs `j, 2m − 3 − j` of the first `2m − 2` jobs sum to `3m`. -/ +theorem tg_pair' (m : ℕ) (j : Fin (2 * m + 1)) (h : (j : ℕ) < 2 * m - 2) : + grahamJobs m j + grahamJobs m ⟨2 * m - 3 - j, by omega⟩ = 3 * m := by + have key : ∀ a b : ℕ, a + b + 2 = m → + 2 * (m : ℝ) - 1 - (a : ℝ) + (2 * (m : ℝ) - 1 - (b : ℝ)) = 3 * m := by + intro a b hab + have : (a : ℝ) + b + 2 = m := by exact_mod_cast hab + linarith + rw [tg_grahamJobs_apply_lt m j (by omega), + tg_grahamJobs_apply_lt m ⟨2 * m - 3 - j, by omega⟩ (by dsimp only; omega)] + exact key _ _ (by dsimp only; omega) + +/-- The pairing `τ₀` (`j ↦ min (j, 2m − 3 − j)` for `j < 2m − 2`, the three jobs of length `m` on +the last machine) +has every load `3m`. -/ +theorem tg_exists_opt (m : ℕ) [NeZero m] : + ∃ τ : Fin (2 * m + 1) → Fin m, ∀ i, load (grahamJobs m) τ i = 3 * m := by + have hm : 0 < m := NeZero.pos m + refine ⟨fun j => if h : (j : ℕ) < 2 * m - 2 then ⟨min (j : ℕ) (2 * m - 3 - j), by omega⟩ + else ⟨m - 1, by omega⟩, fun i => ?_⟩ + have hi := i.isLt + unfold load + by_cases hlt : (i : ℕ) < m - 1 + · have hfib : univ.filter (fun j : Fin (2 * m + 1) => + (if h : (j : ℕ) < 2 * m - 2 then (⟨min (j : ℕ) (2 * m - 3 - j), by omega⟩ : Fin m) + else ⟨m - 1, by omega⟩) = i) = + {(⟨i, by omega⟩ : Fin (2 * m + 1)), ⟨2 * m - 3 - i, by omega⟩} := by + ext j + have hj := j.isLt + simp only [mem_filter, mem_univ, true_and, mem_insert, mem_singleton, Fin.ext_iff] + split_ifs with h1 <;> dsimp only <;> omega + rw [hfib, sum_pair (by rw [Ne, Fin.ext_iff]; dsimp only; omega)] + exact tg_pair' m ⟨i, by omega⟩ (by dsimp only; omega) + · have hfib : univ.filter (fun j : Fin (2 * m + 1) => + (if h : (j : ℕ) < 2 * m - 2 then (⟨min (j : ℕ) (2 * m - 3 - j), by omega⟩ : Fin m) + else ⟨m - 1, by omega⟩) = i) = + {(⟨2 * m - 2, by omega⟩ : Fin (2 * m + 1)), ⟨2 * m - 1, by omega⟩, ⟨2 * m, by omega⟩} := by + ext j + have hj := j.isLt + simp only [mem_filter, mem_univ, true_and, mem_insert, mem_singleton, Fin.ext_iff] + split_ifs with h1 <;> dsimp only <;> omega + rw [hfib, sum_insert (by simp only [mem_insert, mem_singleton, Fin.ext_iff]; omega), + sum_pair (by rw [Ne, Fin.ext_iff]; dsimp only; omega), + tg_grahamJobs_apply_lt m ⟨2 * m - 2, by omega⟩ (by dsimp only; omega), + tg_grahamJobs_apply_lt m ⟨2 * m - 1, by omega⟩ (by dsimp only; omega), + tg_grahamJobs_apply_last m ⟨2 * m, by omega⟩ (by dsimp only; omega)] + have key : ∀ a b : ℕ, a + 1 = m → b + 1 = m → + 2 * (m : ℝ) - 1 - (a : ℝ) + (2 * (m : ℝ) - 1 - (b : ℝ) + m) = 3 * m := by + intro a b ha hb + have h1 : (a : ℝ) + 1 = m := by exact_mod_cast ha + have h2 : (b : ℝ) + 1 = m := by exact_mod_cast hb + linarith + exact key _ _ (by dsimp only; omega) (by dsimp only; omega) + +theorem tg_le_makespan (m : ℕ) [NeZero m] (τ : Fin (2 * m + 1) → Fin m) : + 3 * (m : ℝ) ≤ makespan (grahamJobs m) τ := by + have hm : (0 : ℝ) < m := by exact_mod_cast NeZero.pos m + have h := sum_le_mul_makespan_internal (grahamJobs m) τ + rw [tg_grahamJobs_sum] at h + have h' : (m : ℝ) * (3 * m) ≤ (m : ℝ) * makespan (grahamJobs m) τ := by linarith + exact le_of_mul_le_mul_left h' hm + +/-- The pairing `τ'` (`j ↦ min (j, 2m − 1 − j)`) of the first `2m` jobs has every load `3m − 1` +before index `2m`. -/ +theorem tg_exists_prefix_pairing (m : ℕ) [NeZero m] : + ∃ τ : Fin (2 * m + 1) → Fin m, ∀ i, loadBefore (grahamJobs m) τ (2 * m) i = 3 * m - 1 := by + have hm : 0 < m := NeZero.pos m + refine ⟨fun j => if h : (j : ℕ) < 2 * m then ⟨min (j : ℕ) (2 * m - 1 - j), by omega⟩ + else ⟨0, hm⟩, fun i => ?_⟩ + have hi := i.isLt + unfold loadBefore + have hfib : univ.filter (fun j : Fin (2 * m + 1) => (j : ℕ) < 2 * m ∧ + (if h : (j : ℕ) < 2 * m then (⟨min (j : ℕ) (2 * m - 1 - j), by omega⟩ : Fin m) else ⟨0, hm⟩) + = i) = + {(⟨i, by omega⟩ : Fin (2 * m + 1)), ⟨2 * m - 1 - i, by omega⟩} := by + ext j + have hj := j.isLt + simp only [mem_filter, mem_univ, true_and, mem_insert, mem_singleton, Fin.ext_iff] + split_ifs with h1 <;> dsimp only <;> omega + rw [hfib, sum_pair (by rw [Ne, Fin.ext_iff]; dsimp only; omega)] + exact tg_pair m ⟨i, by omega⟩ (by dsimp only; omega) + +/-- Graham's instance is listed in nonincreasing order. -/ +theorem grahamJobs_antitone_internal (m : ℕ) : Antitone (grahamJobs m) := by + intro a b hab + have hab' : (a : ℕ) ≤ b := hab + by_cases hb : (b : ℕ) < 2 * m + · have ha : (a : ℕ) < 2 * m := by omega + rw [tg_grahamJobs_apply_lt m a ha, tg_grahamJobs_apply_lt m b hb] + have h1 : (a : ℕ) / 2 ≤ (b : ℕ) / 2 := Nat.div_le_div_right hab' + have h2 : (((a : ℕ) / 2 : ℕ) : ℝ) ≤ (((b : ℕ) / 2 : ℕ) : ℝ) := by exact_mod_cast h1 + linarith + · rw [tg_grahamJobs_apply_last m b (by omega)] + exact tg_le_grahamJobs m a + +/-- Every list schedule of Graham's instance in its own order has every load `3m − 1` after the +first `2m` jobs +(the key lemma at `T = 3m − 1`, then the sum `m(3m − 1)`). -/ +theorem tg_loadBefore_two_mul (m : ℕ) [NeZero m] (σ : Fin (2 * m + 1) → Fin m) + (hσ : IsListSchedule (grahamJobs m) σ) (i : Fin m) : + loadBefore (grahamJobs m) σ (2 * m) i = 3 * m - 1 := by + have hm : 0 < m := NeZero.pos m + have hmR : (1 : ℝ) ≤ m := by exact_mod_cast hm + have hp : ∀ j, 0 ≤ grahamJobs m j := tg_grahamJobs_nonneg m + obtain ⟨τ, hτ⟩ := tg_exists_prefix_pairing m + have hle : ∀ i', loadBefore (grahamJobs m) σ (2 * m) i' ≤ 3 * m - 1 := by + intro i' + by_cases hex : ∃ j : Fin (2 * m + 1), (j : ℕ) < 2 * m ∧ σ j = i' + · obtain ⟨k, hk, hσk, heq⟩ := bs_exists_last_job_before (grahamJobs m) σ (2 * m) i' hex + rw [heq, ← hσk] + apply key_lemma (grahamJobs m) hp (grahamJobs_antitone_internal m) σ hσ k τ (3 * m - 1) + · intro i'' + rw [← hτ i''] + exact bs_loadBefore_mono _ hp τ (by omega) i'' + · have := tg_le_grahamJobs m k + linarith + · push Not at hex + rw [bs_loadBefore_eq_zero _ σ _ i' hex] + linarith + have hlast : univ.filter (fun j : Fin (2 * m + 1) => ¬ (j : ℕ) < 2 * m) = + {(⟨2 * m, by omega⟩ : Fin (2 * m + 1))} := by + ext j + have hj := j.isLt + simp only [mem_filter, mem_univ, true_and, mem_singleton, Fin.ext_iff] + omega + have htot := tg_grahamJobs_sum m + rw [← sum_filter_add_sum_filter_not univ (fun j : Fin (2 * m + 1) => (j : ℕ) < 2 * m), hlast, + sum_singleton, tg_grahamJobs_apply_last m ⟨2 * m, by omega⟩ (by dsimp only; omega)] at htot + have hsum := bs_sum_loadBefore (grahamJobs m) σ (2 * m) + by_contra hne + have hlt : loadBefore (grahamJobs m) σ (2 * m) i < 3 * m - 1 := lt_of_le_of_ne (hle i) hne + have hs : ∑ i', loadBefore (grahamJobs m) σ (2 * m) i' < ∑ _i' : Fin m, (3 * (m : ℝ) - 1) := + sum_lt_sum (fun i' _ => hle i') ⟨i, mem_univ _, hlt⟩ + rw [sum_const, card_univ, Fintype.card_fin, nsmul_eq_mul] at hs + nlinarith + +/-- Every list schedule of Graham's instance in its own order has makespan `4m − 1`. -/ +theorem tg_listSchedule_makespan (m : ℕ) [NeZero m] (σ : Fin (2 * m + 1) → Fin m) + (hσ : IsListSchedule (grahamJobs m) σ) : makespan (grahamJobs m) σ = 4 * m - 1 := by + have hm : 0 < m := NeZero.pos m + have hmR : (0 : ℝ) < m := by exact_mod_cast hm + apply le_antisymm + · obtain ⟨τ, hτ⟩ := tg_exists_opt m + have h1 := lpt_bound_internal (grahamJobs m) (tg_grahamJobs_nonneg m) σ + ⟨1, by simpa using grahamJobs_antitone_internal m, by simpa using hσ⟩ τ + have h2 : makespan (grahamJobs m) τ = 3 * m := + le_antisymm ((bs_makespan_le_iff _ _ _).2 (fun i => (hτ i).le)) (tg_le_makespan m τ) + rw [h2] at h1 + have h3 : (3 * (m : ℝ)) * makespan (grahamJobs m) σ ≤ (3 * (m : ℝ)) * (4 * m - 1) := by linarith + exact le_of_mul_le_mul_left h3 (by linarith) + · have h1 := tg_loadBefore_two_mul m σ hσ (σ ⟨2 * m, by omega⟩) + have h2 : loadBefore (grahamJobs m) σ (2 * m + 1) (σ ⟨2 * m, by omega⟩) = + loadBefore (grahamJobs m) σ (2 * m) (σ ⟨2 * m, by omega⟩) + grahamJobs m ⟨2 * m, by omega⟩ + := by + have := bs_loadBefore_succ (grahamJobs m) σ ⟨2 * m, by omega⟩ (σ ⟨2 * m, by omega⟩) + rw [ite_eq_left rfl] at this + exact this + have h3 := bs_loadBefore_of_le (grahamJobs m) σ (2 * m + 1) le_rfl (σ ⟨2 * m, by omega⟩) + have h4 := load_le_makespan_internal (grahamJobs m) σ (σ ⟨2 * m, by omega⟩) + have h5 := tg_grahamJobs_apply_last m ⟨2 * m, by omega⟩ (by dsimp only; omega) + linarith + +/-- An antitone relabeling of Graham's instance leaves the lengths unchanged +(`Tuple.unique_antitone`). -/ +theorem tg_comp_eq (m : ℕ) (π : Equiv.Perm (Fin (2 * m + 1))) (h : Antitone (grahamJobs m ∘ π)) : + grahamJobs m ∘ π = grahamJobs m := by + have h1 : Antitone (grahamJobs m ∘ ⇑(1 : Equiv.Perm (Fin (2 * m + 1)))) := by + simpa using grahamJobs_antitone_internal m + have h2 := Tuple.unique_antitone h h1 + simpa using h2 + +/-- Graham's instance has optimal makespan `3m`. -/ +theorem grahamJobs_optMakespan_internal (m : ℕ) [NeZero m] : optMakespan m (grahamJobs m) = 3 * m + := by + obtain ⟨τ, hτ⟩ := tg_exists_opt m + apply le_antisymm + · calc optMakespan m (grahamJobs m) ≤ makespan (grahamJobs m) τ := optMakespan_le_internal _ τ + _ ≤ 3 * m := (bs_makespan_le_iff _ _ _).2 (fun i => (hτ i).le) + · obtain ⟨τ', hτ'⟩ := exists_makespan_eq_optMakespan_internal (m := m) (grahamJobs m) + rw [← hτ'] + exact tg_le_makespan m τ' + +/-- Every LPT schedule of Graham's instance has makespan `4m − 1`: the bound `4/3 − 1/(3m)` is +attained for every `m`. -/ +theorem grahamJobs_lpt_makespan_internal (m : ℕ) [NeZero m] (σ : Fin (2 * m + 1) → Fin m) + (hσ : IsLPTSchedule (grahamJobs m) σ) : makespan (grahamJobs m) σ = 4 * m - 1 := by + obtain ⟨π, hanti, hls⟩ := hσ + have hc := tg_comp_eq m π hanti + rw [hc] at hls + have h1 := tg_listSchedule_makespan m (σ ∘ π) hls + rw [← makespan_comp_internal (grahamJobs m) σ π, hc, h1] + +end GrahamLPT diff --git a/LeanPool/GrahamLPT/TightList.lean b/LeanPool/GrahamLPT/TightList.lean new file mode 100644 index 0000000000..02e4d15d74 --- /dev/null +++ b/LeanPool/GrahamLPT/TightList.lean @@ -0,0 +1,223 @@ +/- +Copyright (c) 2026 JD Jones. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: JD Jones +-/ + +module + +public import LeanPool.GrahamLPT.Defs +import LeanPool.GrahamLPT.Basic +import LeanPool.GrahamLPT.ListBound +import Mathlib.Algebra.Order.Archimedean.Real.Basic +import Mathlib.Data.Fintype.Fin +import Mathlib.Tactic.Positivity.Finset + +/-! +# TightList + +The unit-job family: optimum `m`, list-schedule makespan `2m − 1`. +Helpers carry the prefix `tl_`; the `_internal` twins of the Challenge theorems are closed in +`Contracts.lean`. +-/ + +@[expose] public section + +namespace GrahamLPT + +open Finset + +theorem tl_unitJobs_apply_lt (m : ℕ) (j : Fin (m * (m - 1) + 1)) (h : (j : ℕ) < m * (m - 1)) : + unitJobs m j = 1 := by + simp [unitJobs, h] + +theorem tl_unitJobs_apply_last (m : ℕ) (j : Fin (m * (m - 1) + 1)) (h : m * (m - 1) ≤ (j : ℕ)) : + unitJobs m j = m := by + simp [unitJobs, not_lt.mpr h] + +theorem tl_unitJobs_nonneg (m : ℕ) (j : Fin (m * (m - 1) + 1)) : 0 ≤ unitJobs m j := by + unfold unitJobs + split_ifs <;> positivity + +/-- Before the long job, the load of a machine is the number of its jobs. -/ +theorem tl_loadBefore_eq_card (m : ℕ) (σ : Fin (m * (m - 1) + 1) → Fin m) (k : ℕ) (hk : k ≤ m * (m + - 1)) + (i : Fin m) : + loadBefore (unitJobs m) σ k i = + ((univ.filter (fun j : Fin (m * (m - 1) + 1) => (j : ℕ) < k ∧ σ j = i)).card : ℝ) := by + unfold loadBefore + rw [Finset.sum_congr rfl (g := fun _ => (1 : ℝ)) (fun j hj => tl_unitJobs_apply_lt m j + (lt_of_lt_of_le (Finset.mem_filter.mp hj).2.1 hk))] + rw [Finset.sum_const, nsmul_eq_mul, mul_one] + +/-- The jobs before `k ≤ m(m − 1)` have total length `k`. -/ +theorem tl_sum_filter_lt (m : ℕ) (k : ℕ) (hk : k ≤ m * (m - 1)) : + ∑ j ∈ univ.filter (fun j : Fin (m * (m - 1) + 1) => (j : ℕ) < k), unitJobs m j = k := by + rw [Finset.sum_congr rfl (g := fun _ => (1 : ℝ)) (fun j hj => tl_unitJobs_apply_lt m j + (lt_of_lt_of_le (Finset.mem_filter.mp hj).2 hk))] + rw [Finset.sum_const, nsmul_eq_mul, mul_one, Fin.card_filter_val_lt, min_eq_right (by omega)] + +theorem tl_nat_le (m c : ℕ) (hm : 1 ≤ m) (h : m * c ≤ m * (m - 1) + (m - 1)) : c ≤ m - 1 := by + obtain ⟨q, rfl⟩ : ∃ q, m = q + 1 := ⟨m - 1, by omega⟩ + simp only [Nat.add_sub_cancel] at h ⊢ + by_contra hc + have hc' : q + 1 ≤ c := by omega + nlinarith + +theorem tl_div_lt (m j : ℕ) (hm : 0 < m) (h : j < m * (m - 1)) : j / m < m - 1 := by + rw [Nat.div_lt_iff_lt_mul hm, Nat.mul_comm] + exact h + +/-- The invariant of a list schedule of the unit jobs: `m · loadBefore k i ≤ k + m − 1` for `k ≤ +m(m − 1)`. -/ +theorem tl_loadBefore_le (m : ℕ) [NeZero m] (σ : Fin (m * (m - 1) + 1) → Fin m) + (hσ : IsListSchedule (unitJobs m) σ) (k : ℕ) (hk : k ≤ m * (m - 1)) (i : Fin m) : + (m : ℝ) * loadBefore (unitJobs m) σ k i ≤ k + m - 1 := by + have hm : (1 : ℝ) ≤ m := by exact_mod_cast (NeZero.one_le : 1 ≤ m) + induction k with + | zero => + rw [bs_loadBefore_zero] + push_cast + linarith + | succ k ih => + have hk' : k < m * (m - 1) := by omega + have hk1 : k < m * (m - 1) + 1 := by omega + have ih' := ih (by omega) + have h := bs_loadBefore_succ (unitJobs m) σ ⟨k, hk1⟩ i + rw [h, tl_unitJobs_apply_lt m ⟨k, hk1⟩ hk'] + push_cast + by_cases hi : σ ⟨k, hk1⟩ = i + · rw [ite_eq_left hi] + have h2 := bs_mul_loadBefore_le (unitJobs m) σ hσ ⟨k, hk1⟩ + rw [tl_sum_filter_lt m k hk'.le, hi] at h2 + linarith + · rw [ite_eq_right hi] + linarith + +/-- Every load after the unit jobs is `m − 1`. -/ +theorem tl_loadBefore_units (m : ℕ) [NeZero m] (σ : Fin (m * (m - 1) + 1) → Fin m) + (hσ : IsListSchedule (unitJobs m) σ) (i : Fin m) : + loadBefore (unitJobs m) σ (m * (m - 1)) i = m - 1 := by + have hm : 1 ≤ m := NeZero.one_le + have hle : ∀ i' : Fin m, loadBefore (unitJobs m) σ (m * (m - 1)) i' ≤ (m : ℝ) - 1 := by + intro i' + have h1 := tl_loadBefore_le m σ hσ (m * (m - 1)) le_rfl i' + obtain ⟨c, hc⟩ : ∃ c : ℕ, loadBefore (unitJobs m) σ (m * (m - 1)) i' = c := + ⟨_, tl_loadBefore_eq_card m σ (m * (m - 1)) le_rfl i'⟩ + rw [hc] at h1 ⊢ + have h2 : ((m * c : ℕ) : ℝ) ≤ ((m * (m - 1) + (m - 1) : ℕ) : ℝ) := by + push_cast [Nat.cast_sub hm] at h1 ⊢ + linarith + have h3 := tl_nat_le m c hm (by exact_mod_cast h2) + have h4 : ((c : ℕ) : ℝ) ≤ ((m - 1 : ℕ) : ℝ) := by exact_mod_cast h3 + rw [Nat.cast_sub hm] at h4 + simpa using h4 + have hsum : ∑ i', loadBefore (unitJobs m) σ (m * (m - 1)) i' = ∑ _i' : Fin m, ((m : ℝ) - 1) := by + rw [bs_sum_loadBefore, tl_sum_filter_lt m (m * (m - 1)) le_rfl, Finset.sum_const, + Finset.card_univ, + Fintype.card_fin, nsmul_eq_mul] + push_cast [Nat.cast_sub hm] + ring + exact (Finset.sum_eq_sum_iff_of_le (fun i' _ => hle i')).1 hsum i (Finset.mem_univ _) + +theorem tl_le_makespan (m : ℕ) [NeZero m] (τ : Fin (m * (m - 1) + 1) → Fin m) : + (m : ℝ) ≤ makespan (unitJobs m) τ := by + have h := le_makespan_of_nonneg_internal (unitJobs m) (tl_unitJobs_nonneg m) τ (Fin.last _) + rwa [tl_unitJobs_apply_last m _ (by simp)] at h + +/-- An assignment of makespan `m`: the unit jobs spread `m` per machine over `m − 1` machines, the +long job alone. -/ +theorem tl_exists_makespan_eq (m : ℕ) [NeZero m] : + ∃ τ : Fin (m * (m - 1) + 1) → Fin m, makespan (unitJobs m) τ = m := by + have hm : 0 < m := NeZero.pos m + let τ : Fin (m * (m - 1) + 1) → Fin m := fun j => + if h : (j : ℕ) < m * (m - 1) then ⟨(j : ℕ) / m, by have := tl_div_lt m j hm h; omega⟩ + else ⟨m - 1, by omega⟩ + have hτ : ∀ j : Fin (m * (m - 1) + 1), + ((τ j : Fin m) : ℕ) = if (j : ℕ) < m * (m - 1) then (j : ℕ) / m else m - 1 := by + intro j + by_cases h : (j : ℕ) < m * (m - 1) <;> simp [τ, h] + refine ⟨τ, le_antisymm ?_ (tl_le_makespan m τ)⟩ + rw [bs_makespan_le_iff] + intro i + unfold load + by_cases hi : (i : ℕ) = m - 1 + · calc ∑ j ∈ univ.filter (fun j => τ j = i), unitJobs m j + ≤ ∑ j ∈ ({Fin.last _} : Finset (Fin (m * (m - 1) + 1))), unitJobs m j := by + apply Finset.sum_le_sum_of_subset_of_nonneg + · intro j hj + simp only [Finset.mem_filter, Finset.mem_univ, true_and] at hj + rw [Finset.mem_singleton] + by_contra hne + have hj' : (j : ℕ) < m * (m - 1) := by + have := Fin.val_lt_last hne + simpa using this + have h1 := hτ j + rw [hj, ite_eq_left hj'] at h1 + have := tl_div_lt m j hm hj' + omega + · intro j _ _ + exact tl_unitJobs_nonneg m j + _ = m := by rw [Finset.sum_singleton, tl_unitJobs_apply_last m _ (by simp)] + · have hunit : ∀ j ∈ univ.filter (fun j => τ j = i), unitJobs m j = 1 := by + intro j hj + simp only [Finset.mem_filter, Finset.mem_univ, true_and] at hj + apply tl_unitJobs_apply_lt + by_contra hj' + have h1 := hτ j + rw [hj, ite_eq_right hj'] at h1 + exact hi h1 + rw [Finset.sum_congr rfl hunit, Finset.sum_const, nsmul_eq_mul, mul_one] + have hcard : (univ.filter (fun j => τ j = i)).card ≤ m := by + rw [← Finset.card_map Fin.valEmbedding] + calc ((univ.filter (fun j => τ j = i)).map Fin.valEmbedding).card + ≤ (Finset.Ico (m * (i : ℕ)) (m * (i : ℕ) + m)).card := by + apply Finset.card_le_card + intro x hx + simp only [Finset.mem_map, Finset.mem_filter, Finset.mem_univ, true_and, + Fin.valEmbedding_apply] at hx + obtain ⟨j, hj, rfl⟩ := hx + have hj' : (j : ℕ) < m * (m - 1) := by + by_contra hj' + have h1 := hτ j + rw [hj, ite_eq_right hj'] at h1 + exact hi h1 + have h1 := hτ j + rw [hj, ite_eq_left hj'] at h1 + have h2 := Nat.div_add_mod (j : ℕ) m + have h3 := Nat.mod_lt (j : ℕ) hm + rw [← h1] at h2 + rw [Finset.mem_Ico] + omega + _ = m := by rw [Nat.card_Ico]; omega + exact_mod_cast hcard + +/-- The `m(m − 1)` unit jobs with one job of length `m` have optimal makespan `m`. -/ +theorem unitJobs_optMakespan_internal (m : ℕ) [NeZero m] : optMakespan m (unitJobs m) = m := by + apply le_antisymm + · obtain ⟨τ, hτ⟩ := tl_exists_makespan_eq m + rw [← hτ] + exact optMakespan_le_internal _ τ + · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) (unitJobs m) + rw [← hτ] + exact tl_le_makespan m τ + +/-- Every list schedule of the unit jobs followed by the job of length `m` has makespan `2m − 1`. -/ +theorem unitJobs_listSchedule_makespan_internal (m : ℕ) [NeZero m] (σ : Fin (m * (m - 1) + 1) → + Fin m) + (hσ : IsListSchedule (unitJobs m) σ) : makespan (unitJobs m) σ = 2 * m - 1 := by + have hm : (1 : ℝ) ≤ m := by exact_mod_cast (NeZero.one_le : 1 ≤ m) + obtain ⟨τ, hτ⟩ := tl_exists_makespan_eq m + apply le_antisymm + · have h := listSchedule_bound_internal (unitJobs m) (tl_unitJobs_nonneg m) σ hσ τ + rw [hτ] at h + exact le_of_mul_le_mul_left (a := (m : ℝ)) (by linarith) (by linarith) + · have h1 := bs_loadBefore_succ (unitJobs m) σ (Fin.last _) (σ (Fin.last _)) + rw [ite_eq_left rfl, tl_unitJobs_apply_last m _ (by simp)] at h1 + simp only [Fin.val_last] at h1 + rw [bs_loadBefore_of_le (unitJobs m) σ (m * (m - 1) + 1) le_rfl, tl_loadBefore_units m σ hσ] + at h1 + have h2 := load_le_makespan_internal (unitJobs m) σ (σ (Fin.last _)) + linarith + +end GrahamLPT diff --git a/LeanPool/projects/graham-lpt.yaml b/LeanPool/projects/graham-lpt.yaml new file mode 100644 index 0000000000..d456937dbf --- /dev/null +++ b/LeanPool/projects/graham-lpt.yaml @@ -0,0 +1,57 @@ +slug: graham-lpt +title: Sharp list-scheduling and longest-processing-time bounds +summary: Formalizes identical-machine scheduling for arbitrary finite job sets + with real processing times. Proves Graham's sharp list-scheduling and LPT + approximation bounds, constructs their tight instances, characterizes all + positive instances attaining the LPT bound, and establishes the supremum + for every sufficiently large fixed job count. +branch: approximation algorithms and scheduling +entry_module: LeanPool.GrahamLPT +authors: +- JD Jones +source: + title: Graham's bounds for list scheduling and LPT on identical machines + authors: + - JD Jones + url: https://github.com/JD-Jones-ASES/graham-lpt-lean/tree/c8ed035b407cc554faf4b68df0cf3edc70058977 + github_repo: JD-Jones-ASES/graham-lpt-lean + commit: c8ed035b407cc554faf4b68df0cf3edc70058977 +license: MIT +status: verified +provenance: AI +main_declarations: +- GrahamLPT.lpt_le_optMakespan +- GrahamLPT.lpt_eq_bound_iff_graham +main_results: +- declaration: GrahamLPT.listSchedule_le_optMakespan + informal: For nonnegative processing times on m nonzero identical machines, + every list schedule has makespan at most (2 - 1/m) times the optimal makespan. +- declaration: GrahamLPT.lpt_le_optMakespan + informal: For nonnegative processing times on m nonzero identical machines, + every longest-processing-time-first schedule has makespan at most + (4/3 - 1/(3m)) times the optimal makespan. +- declaration: GrahamLPT.isLeast_lpt_ratio + informal: For each nonzero machine count, 4/3 - 1/(3m) is the least universal + approximation factor for LPT, over all finite nonnegative real job sets. +- declaration: GrahamLPT.lpt_eq_bound_iff_graham + informal: For at least two machines and a nonempty set of positive-length + jobs, an LPT schedule attains Graham's bound exactly if the instance is + a positive scalar multiple and permutation of Graham's 2m + 1 jobs. +- declaration: GrahamLPT.isLUB_lpt_ratio_of_card + informal: For a nonzero machine count and every fixed job count n at least + 2m + 1, the supremum of LPT-to-optimum makespan ratios over positive + instances with n jobs remains 4/3 - 1/(3m). +- declaration: GrahamLPT.exists_isLPTSchedule + informal: Every finite real job-length vector on a nonzero number of + machines admits an LPT schedule. +- declaration: GrahamLPT.exists_listSchedule_le + informal: Every assignment of nonnegative-length jobs is matched or + improved by a list schedule in some ordering of the jobs. +tags: +- scheduling +- approximation-algorithms +- combinatorial-optimization +msc: +- 68M20 +- 90B35 +- 68W25 From 616cc2dd4878920103867423b4b359c7e04d91e6 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 20 Oct 2026 10:34:55 +0000 Subject: [PATCH 2/5] Share scheduling prefix proofs and expose theorem implementations directly --- LeanPool/GrahamLPT.lean | 20 ++- LeanPool/GrahamLPT/Basic.lean | 50 ++++-- LeanPool/GrahamLPT/Certificates.lean | 26 +-- LeanPool/GrahamLPT/CoffmanSethi.lean | 8 +- LeanPool/GrahamLPT/Contracts.lean | 255 --------------------------- LeanPool/GrahamLPT/Counter.lean | 8 +- LeanPool/GrahamLPT/Equality.lean | 10 +- LeanPool/GrahamLPT/FixedCount.lean | 131 ++++++-------- LeanPool/GrahamLPT/GrahamScaled.lean | 28 +-- LeanPool/GrahamLPT/Imports.lean | 1 - LeanPool/GrahamLPT/Key.lean | 20 +-- LeanPool/GrahamLPT/LPTBound.lean | 16 +- LeanPool/GrahamLPT/LPTForm.lean | 22 +-- LeanPool/GrahamLPT/ListBound.lean | 14 +- LeanPool/GrahamLPT/ListOptimum.lean | 14 +- LeanPool/GrahamLPT/OptList.lean | 14 +- LeanPool/GrahamLPT/Ratio.lean | 22 ++- LeanPool/GrahamLPT/TightLPT.lean | 26 ++- LeanPool/GrahamLPT/TightList.lean | 16 +- 19 files changed, 226 insertions(+), 475 deletions(-) delete mode 100644 LeanPool/GrahamLPT/Contracts.lean diff --git a/LeanPool/GrahamLPT.lean b/LeanPool/GrahamLPT.lean index c49c60dfd6..22f9cb8564 100644 --- a/LeanPool/GrahamLPT.lean +++ b/LeanPool/GrahamLPT.lean @@ -33,9 +33,23 @@ SOFTWARE. module -public import LeanPool.GrahamLPT.Contracts -import Mathlib.Data.Rat.Floor -import Mathlib.Tactic.Positivity.Finset +public import LeanPool.GrahamLPT.Basic +public import LeanPool.GrahamLPT.Certificates +public import LeanPool.GrahamLPT.CoffmanSethi +public import LeanPool.GrahamLPT.Counter +public import LeanPool.GrahamLPT.Defs +public import LeanPool.GrahamLPT.Equality +public import LeanPool.GrahamLPT.FixedCount +public import LeanPool.GrahamLPT.GrahamScaled +public import LeanPool.GrahamLPT.Key +public import LeanPool.GrahamLPT.LPTBound +public import LeanPool.GrahamLPT.LPTForm +public import LeanPool.GrahamLPT.ListBound +public import LeanPool.GrahamLPT.ListOptimum +public import LeanPool.GrahamLPT.OptList +public import LeanPool.GrahamLPT.Ratio +public import LeanPool.GrahamLPT.TightLPT +public import LeanPool.GrahamLPT.TightList /-! # Sharp list-scheduling and longest-processing-time bounds diff --git a/LeanPool/GrahamLPT/Basic.lean b/LeanPool/GrahamLPT/Basic.lean index 70f1e30215..8092c810e6 100644 --- a/LeanPool/GrahamLPT/Basic.lean +++ b/LeanPool/GrahamLPT/Basic.lean @@ -17,8 +17,6 @@ import Mathlib.Tactic.Positivity.Finset # Basic Loads, makespans, the existence of list and LPT schedules, the attained optimum, relabeling. -Helpers carry the prefix `bs_`; the `_internal` twins of the Challenge theorems are closed in -`Contracts.lean`. -/ @[expose] public section @@ -64,6 +62,36 @@ theorem bs_loadBefore_of_le {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin have := j.isLt exact ⟨fun h => h.2, fun h => ⟨by omega, h⟩⟩ +/-- Restricting a job vector and assignment preserves every load in the retained prefix. -/ +theorem loadBefore_restrict {m n N : ℕ} (h : n ≤ N) (p : Fin N → ℝ) + (σ : Fin N → Fin m) (k : ℕ) (hk : k ≤ n) (i : Fin m) : + loadBefore (p ∘ Fin.castLE h) (σ ∘ Fin.castLE h) k i = loadBefore p σ k i := by + unfold loadBefore + refine Finset.sum_bij (fun j _ => Fin.castLE h j) ?_ ?_ ?_ ?_ + · intro j hj + simpa only [mem_filter, mem_univ, true_and, Function.comp_apply, Fin.val_castLE] using hj + · intro a _ b _ hab + apply Fin.ext + simpa only [Fin.val_castLE] using congrArg (fun j : Fin N => (j : ℕ)) hab + · intro j hj + have hj' := (mem_filter.mp hj).2 + have hcast : Fin.castLE h (⟨j, lt_of_lt_of_le hj'.1 hk⟩ : Fin n) = j := by + apply Fin.ext + simp only [Fin.val_castLE] + refine ⟨⟨j, lt_of_lt_of_le hj'.1 hk⟩, ?_, hcast⟩ + simpa only [mem_filter, mem_univ, true_and, Function.comp_apply, hcast] using hj' + · intro j _ + rfl + +/-- A list schedule restricts to a list schedule of any initial segment of the jobs. -/ +theorem IsListSchedule.restrict {m n N : ℕ} (h : n ≤ N) (p : Fin N → ℝ) + (σ : Fin N → Fin m) (hσ : IsListSchedule p σ) : + IsListSchedule (p ∘ Fin.castLE h) (σ ∘ Fin.castLE h) := by + intro k i + rw [loadBefore_restrict h p σ k k.isLt.le, + loadBefore_restrict h p σ k k.isLt.le] + simpa only [Fin.val_castLE, Function.comp_apply] using hσ (Fin.castLE h k) i + /-- The loads before `k` sum to the lengths of the jobs before `k`. -/ theorem bs_sum_loadBefore {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (k : ℕ) : ∑ i, loadBefore p σ k i = ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k), p j := by @@ -251,14 +279,14 @@ theorem bs_loadBefore_greedy {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : simp [hi, hi'] /-- A list schedule exists. -/ -theorem exists_isListSchedule_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : +theorem exists_isListSchedule {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : ∃ σ : Fin n → Fin m, IsListSchedule p σ := by refine ⟨fun j : Fin n => leastLoadedMachine (greedyLoads p (j : ℕ)), fun k i => ?_⟩ rw [bs_loadBefore_greedy p k k.isLt.le, bs_loadBefore_greedy p k k.isLt.le] exact bs_argmin_le _ i /-- An LPT schedule exists. -/ -theorem exists_isLPTSchedule_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : +theorem exists_isLPTSchedule {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : ∃ σ : Fin n → Fin m, IsLPTSchedule p σ := by set π := Tuple.sort (fun j => -p j) with hπ have hanti : Antitone (p ∘ π) := by @@ -266,7 +294,7 @@ theorem exists_isLPTSchedule_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) have := Tuple.monotone_sort (fun j => -p j) hab simp only [Function.comp] at this ⊢ linarith - obtain ⟨σ', hσ'⟩ := exists_isListSchedule_internal (m := m) (p ∘ π) + obtain ⟨σ', hσ'⟩ := exists_isListSchedule (m := m) (p ∘ π) refine ⟨σ' ∘ π.symm, π, hanti, ?_⟩ have e : (σ' ∘ ⇑π.symm) ∘ ⇑π = σ' := by funext j @@ -275,35 +303,35 @@ theorem exists_isLPTSchedule_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) exact hσ' /-- The optimal makespan is at most the makespan of every assignment. -/ -theorem optMakespan_le_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (τ : Fin n → Fin m) : +theorem optMakespan_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (τ : Fin n → Fin m) : optMakespan m p ≤ makespan p τ := Finset.inf'_le (fun σ : Fin n → Fin m => makespan p σ) (mem_univ τ) /-- The optimal makespan is attained. -/ -theorem exists_makespan_eq_optMakespan_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : +theorem exists_makespan_eq_optMakespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : ∃ τ : Fin n → Fin m, makespan p τ = optMakespan m p := bs_exists_makespan_eq_opt p /-- Every machine load is at most the makespan. -/ -theorem load_le_makespan_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : +theorem load_le_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : Fin m) : load p σ i ≤ makespan p σ := bs_load_le_makespan p σ i /-- For nonnegative lengths every job is at most the makespan. -/ -theorem le_makespan_of_nonneg_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) +theorem le_makespan_of_nonneg {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : Fin n → Fin m) (j : Fin n) : p j ≤ makespan p σ := by refine le_trans ?_ (bs_load_le_makespan p σ (σ j)) exact Finset.single_le_sum (fun j _ => hp j) (by simp : j ∈ univ.filter (fun j' : Fin n => σ j' = σ j)) /-- The total length is at most `m` times the makespan. -/ -theorem sum_le_mul_makespan_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) : +theorem sum_le_mul_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) : ∑ j, p j ≤ (m : ℝ) * makespan p σ := bs_sum_le_mul_makespan p σ /-- Relabeling the jobs by a permutation does not change the makespan. -/ -theorem makespan_comp_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (π : +theorem makespan_comp {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (π : Equiv.Perm (Fin n)) : makespan (p ∘ π) (σ ∘ π) = makespan p σ := by have h : load (p ∘ π) (σ ∘ π) = load p σ := funext (bs_load_comp p σ π) diff --git a/LeanPool/GrahamLPT/Certificates.lean b/LeanPool/GrahamLPT/Certificates.lean index 1d0823585d..c2322b00ae 100644 --- a/LeanPool/GrahamLPT/Certificates.lean +++ b/LeanPool/GrahamLPT/Certificates.lean @@ -35,7 +35,7 @@ theorem ct_key_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (τ : Fin n → Fin m) (h3 : makespan p τ < 3 * p k) : loadBefore p σ k (σ k) + p k ≤ makespan p τ := key_lemma p hp hanti σ hσ k τ (makespan p τ) - (fun i => (bs_loadBefore_le_load p hp τ _ i).trans (load_le_makespan_internal p τ i)) h3 + (fun i => (bs_loadBefore_le_load p hp τ _ i).trans (load_le_makespan p τ i)) h3 /-- The scalar step of the equality structure for `T > 0`: `L` the least load before `k`, `P = p_k`, `S` the @@ -79,7 +79,7 @@ completion time is the makespan, the smaller of `C(σ)` and `3 p_k` is at most `C(τ)` for every assignment `τ` (the key lemma read as a lower bound on every comparison schedule). -/ -theorem lpt_critical_min_le_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) +theorem lpt_critical_min_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (hk : makespan p σ = loadBefore p σ k (σ k) + p k) @@ -95,15 +95,15 @@ theorem lpt_critical_min_le_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) third of the makespan it completes, the schedule is optimal (`lpt_eq_optMakespan_of_third_lt` asks every job to exceed a third of the unknown optimum). -/ -theorem lpt_eq_optMakespan_of_critical_third_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ +theorem lpt_eq_optMakespan_of_critical_third {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (hk : makespan p σ = loadBefore p σ k (σ k) + p k) (h3 : makespan p σ ≤ 3 * p k) : makespan p σ = optMakespan m p := by - obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p - have h := lpt_critical_min_le_internal p hp hanti σ hσ k hk τ + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) p + have h := lpt_critical_min_le p hp hanti σ hσ k hk τ rw [min_eq_left h3, hτ] at h - exact le_antisymm h (optMakespan_le_internal p σ) + exact le_antisymm h (optMakespan_le p σ) /-- In a list schedule `σ` of a nonincreasing `p` on `m ≥ 2` machines, with `k` a critical job, equality in Graham's @@ -112,7 +112,7 @@ every machine of `σ` carries the least load before `k`, every machine of `τ` carries exactly `C(τ)`, and every job after `k` has length `0`. -/ -theorem lpt_eq_bound_structure_internal {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (p : Fin n → ℝ) (hp : ∀ +theorem lpt_eq_bound_structure {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (hk : makespan p σ = loadBefore p σ k (σ k) + p k) (τ : Fin n → Fin m) @@ -129,7 +129,7 @@ theorem lpt_eq_bound_structure_internal {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (p exact (mul_eq_zero.mp heq).resolve_left h3m.ne' have hz : ∀ j, p j = 0 := by intro j - have h := le_makespan_of_nonneg_internal p hp σ j + have h := le_makespan_of_nonneg p hp σ j rw [hC0] at h exact le_antisymm h (hp j) refine ⟨?_, ?_, ?_, fun j _ => hz j⟩ @@ -145,7 +145,7 @@ theorem lpt_eq_bound_structure_internal {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (p · -- `C(τ) > 0`: the scalar step, then each tight inequality read off obtain ⟨hP, hS, hW, hWT⟩ := ct_eq_scalar (m : ℝ) (loadBefore p σ k (σ k)) (p k) (∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k), p j) (∑ j, p j) (makespan p τ) hm' hT - (bs_mul_loadBefore_le p σ hσ k) (bs_sum_filter_add_le p hp k) (sum_le_mul_makespan_internal + (bs_mul_loadBefore_le p σ hσ k) (bs_sum_filter_add_le p hp k) (sum_le_mul_makespan p τ) (ct_key_le p hp hanti σ hσ k τ) (by rw [← hk]; exact heq) refine ⟨hP, ?_, ?_, ?_⟩ @@ -165,7 +165,7 @@ theorem lpt_eq_bound_structure_internal {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (p nsmul_eq_mul] linarith have h := (Finset.sum_eq_zero_iff_of_nonneg - (fun i _ => sub_nonneg.2 (load_le_makespan_internal p τ i))).mp hsum + (fun i _ => sub_nonneg.2 (load_le_makespan p τ i))).mp hsum intro i have hi := h i (mem_univ i) linarith @@ -186,7 +186,7 @@ nonincreasing `p`, if a machine `i` other than the critical job's holds at least `q` jobs before the critical job `k`, and `q + 2 ≤ m`, then `q(m − 1) · C(σ) ≤ ((q + 1)(m − 1) − 1) · C(τ)` for every assignment `τ`. -/ -theorem lpt_bound_of_other_card_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) +theorem lpt_bound_of_other_card {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (hk : makespan p σ = loadBefore p σ k (σ k) + p k) @@ -228,7 +228,7 @@ theorem lpt_bound_of_other_card_internal {m n : ℕ} [NeZero m] (p : Fin n → rw [eF, card_insert_of_notMem hnot] push_cast ring - have hchen := lpt_job_position_le_internal p hp hanti σ hσ j₀ τ + have hchen := lpt_job_position_le p hp hanti σ hσ j₀ τ rw [← hcard] at hchen have hpk : p k ≤ p j₀ := hanti (Fin.le_iff_val_le_val.mpr hj₀.1.le) calc (q : ℝ) * p k ≤ (q : ℝ) * p j₀ := mul_le_mul_of_nonneg_left hpk hq0 @@ -270,6 +270,6 @@ theorem lpt_bound_of_other_card_internal {m n : ℕ} [NeZero m] (p : Fin n → exact h rw [hk] exact ct_other_scalar (m : ℝ) q (loadBefore p σ k (σ k)) (p k) (∑ j, p j) (makespan p τ) hq0 hm' - (by linarith) (sum_le_mul_makespan_internal p τ) hqP + (by linarith) (sum_le_mul_makespan p τ) hqP end GrahamLPT diff --git a/LeanPool/GrahamLPT/CoffmanSethi.lean b/LeanPool/GrahamLPT/CoffmanSethi.lean index 753bb49e51..2e7af627d6 100644 --- a/LeanPool/GrahamLPT/CoffmanSethi.lean +++ b/LeanPool/GrahamLPT/CoffmanSethi.lean @@ -398,21 +398,21 @@ corrected by Chen 1993, as Della Croce and Scatamacchia restate it; the literature states it for `q ≥ 3`; for `m ≥ 2` it is weaker than `lpt_bound` at `q ≤ 2`, and its attainment is not proved here). -/ -theorem lpt_bound_of_card_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) +theorem lpt_bound_of_card {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (τ : Fin n → Fin m) (i : Fin m) (hi : load p σ i = makespan p σ) : ((univ.filter (fun j : Fin n => σ j = i)).card : ℝ) * m * makespan p σ ≤ (((univ.filter (fun j : Fin n => σ j = i)).card + 1) * m - 1) * makespan p τ := by obtain ⟨π, hanti, hl⟩ := hσ have hi' : load (p ∘ π) (σ ∘ π) i = makespan (p ∘ π) (σ ∘ π) := by - rw [bs_load_comp, makespan_comp_internal, hi] + rw [bs_load_comp, makespan_comp, hi] have h := cs_bound (p ∘ π) (fun j => hp _) hanti (σ ∘ π) hl (τ ∘ π) i hi' have hcard : (univ.filter (fun j : Fin n => (σ ∘ π) j = i)).card = (univ.filter (fun j : Fin n => σ j = i)).card := Finset.card_equiv π (fun j => by simp) - rwa [hcard, makespan_comp_internal, makespan_comp_internal] at h + rwa [hcard, makespan_comp, makespan_comp] at h -theorem lpt_job_position_le_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) +theorem lpt_job_position_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (τ : Fin n → Fin m) : (((univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = σ k)).card : ℝ) + 1) * p k ≤ makespan p τ diff --git a/LeanPool/GrahamLPT/Contracts.lean b/LeanPool/GrahamLPT/Contracts.lean deleted file mode 100644 index 750f17a677..0000000000 --- a/LeanPool/GrahamLPT/Contracts.lean +++ /dev/null @@ -1,255 +0,0 @@ -/- -Copyright (c) 2026 JD Jones. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: JD Jones --/ - -module - -public import LeanPool.GrahamLPT.Defs -public import Mathlib.Data.Fin.VecNotation -import LeanPool.GrahamLPT.Basic -import LeanPool.GrahamLPT.Certificates -import LeanPool.GrahamLPT.CoffmanSethi -import LeanPool.GrahamLPT.Counter -import LeanPool.GrahamLPT.Equality -import LeanPool.GrahamLPT.FixedCount -import LeanPool.GrahamLPT.GrahamScaled -import LeanPool.GrahamLPT.Key -import LeanPool.GrahamLPT.LPTBound -import LeanPool.GrahamLPT.LPTForm -import LeanPool.GrahamLPT.ListBound -import LeanPool.GrahamLPT.ListOptimum -import LeanPool.GrahamLPT.OptList -import LeanPool.GrahamLPT.Ratio -import LeanPool.GrahamLPT.TightLPT -import LeanPool.GrahamLPT.TightList -import Mathlib.Tactic.Positivity.Finset - -/-! -# Scheduling theorem contracts - -The named results of the upstream formalization, proved using the internal library. -The definitions and all theorem statements are preserved from that development. --/ - -@[expose] public section - -namespace GrahamLPT - -open Finset - -theorem exists_isListSchedule {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : - ∃ σ : Fin n → Fin m, IsListSchedule p σ := - exists_isListSchedule_internal p - -theorem exists_isLPTSchedule {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : - ∃ σ : Fin n → Fin m, IsLPTSchedule p σ := - exists_isLPTSchedule_internal p - -theorem optMakespan_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (τ : Fin n → Fin m) : - optMakespan m p ≤ makespan p τ := - optMakespan_le_internal p τ - -theorem exists_makespan_eq_optMakespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : - ∃ τ : Fin n → Fin m, makespan p τ = optMakespan m p := - exists_makespan_eq_optMakespan_internal p - -theorem load_le_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : Fin m) : - load p σ i ≤ makespan p σ := - load_le_makespan_internal p σ i - -theorem le_makespan_of_nonneg {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) - (σ : Fin n → Fin m) (j : Fin n) : p j ≤ makespan p σ := - le_makespan_of_nonneg_internal p hp σ j - -theorem sum_le_mul_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) : - ∑ j, p j ≤ (m : ℝ) * makespan p σ := - sum_le_mul_makespan_internal p σ - -theorem makespan_comp {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (π : Equiv.Perm - (Fin n)) : - makespan (p ∘ π) (σ ∘ π) = makespan p σ := - makespan_comp_internal p σ π - -theorem listSchedule_bound {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) - (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (τ : Fin n → Fin m) : - (m : ℝ) * makespan p σ ≤ (2 * m - 1) * makespan p τ := - listSchedule_bound_internal p hp σ hσ τ - -theorem listSchedule_le_optMakespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) - (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) : - makespan p σ ≤ (2 - 1 / m) * optMakespan m p := - listSchedule_le_optMakespan_internal p hp σ hσ - -theorem unitJobs_optMakespan (m : ℕ) [NeZero m] : optMakespan m (unitJobs m) = m := - unitJobs_optMakespan_internal m - -theorem unitJobs_listSchedule_makespan (m : ℕ) [NeZero m] (σ : Fin (m * (m - 1) + 1) → Fin m) - (hσ : IsListSchedule (unitJobs m) σ) : makespan (unitJobs m) σ = 2 * m - 1 := - unitJobs_listSchedule_makespan_internal m σ hσ - -theorem isLeast_listSchedule_ratio (m : ℕ) [NeZero m] : - IsLeast {c : ℝ | ∀ (n : ℕ) (p : Fin n → ℝ) (σ τ : Fin n → Fin m), (∀ j, 0 ≤ p j) → - IsListSchedule p σ → makespan p σ ≤ c * makespan p τ} (2 - 1 / m) := - isLeast_listSchedule_ratio_internal m - -theorem lpt_bound {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) - (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (τ : Fin n → Fin m) : - 3 * (m : ℝ) * makespan p σ ≤ (4 * m - 1) * makespan p τ := - lpt_bound_internal p hp σ hσ τ - -theorem lpt_le_optMakespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) - (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) : - makespan p σ ≤ (4 / 3 - 1 / (3 * m)) * optMakespan m p := - lpt_le_optMakespan_internal p hp σ hσ - -theorem lpt_optimal_of_third_lt {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) - (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (τ : Fin n → Fin m) - (h : ∀ j, makespan p τ < 3 * p j) : makespan p σ ≤ makespan p τ := - lpt_optimal_of_third_lt_internal p hp σ hσ τ h - -theorem lpt_eq_optMakespan_of_third_lt {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) - (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (h : ∀ j, optMakespan m p < 3 * p j) : - makespan p σ = optMakespan m p := - lpt_eq_optMakespan_of_third_lt_internal p hp σ hσ h - -theorem grahamJobs_antitone (m : ℕ) : Antitone (grahamJobs m) := - grahamJobs_antitone_internal m - -theorem grahamJobs_optMakespan (m : ℕ) [NeZero m] : optMakespan m (grahamJobs m) = 3 * m := - grahamJobs_optMakespan_internal m - -theorem grahamOrder_bijective (m : ℕ) : Function.Bijective (grahamOrder m) := - grahamOrder_bijective_internal m - -theorem grahamJobs_grahamOrder (m : ℕ) (i : Fin (2 * m + 1)) : - grahamJobs m (grahamOrder m i) = - if (i : ℕ) < m - 1 then 2 * (m : ℝ) - 1 - ((i : ℕ) : ℝ) - else if (i : ℕ) ≤ m then (m : ℝ) - else if (i : ℕ) < 2 * m then 3 * (m : ℝ) - ((i : ℕ) : ℝ) - else (m : ℝ) := - grahamJobs_grahamOrder_internal m i - -theorem grahamJobs_exists_optimal_listSchedule (m : ℕ) [NeZero m] : - ∃ σ : Fin (2 * m + 1) → Fin m, - IsListSchedule (grahamJobs m ∘ grahamOrder m) (σ ∘ grahamOrder m) ∧ makespan (grahamJobs m) - σ = 3 * m := - grahamJobs_exists_optimal_listSchedule_internal m - -theorem grahamJobs_lpt_makespan (m : ℕ) [NeZero m] (σ : Fin (2 * m + 1) → Fin m) - (hσ : IsLPTSchedule (grahamJobs m) σ) : makespan (grahamJobs m) σ = 4 * m - 1 := - grahamJobs_lpt_makespan_internal m σ hσ - -theorem isLeast_lpt_ratio (m : ℕ) [NeZero m] : - IsLeast {c : ℝ | ∀ (n : ℕ) (p : Fin n → ℝ) (σ τ : Fin n → Fin m), (∀ j, 0 ≤ p j) → - IsLPTSchedule p σ → makespan p σ ≤ c * makespan p τ} (4 / 3 - 1 / (3 * m)) := - isLeast_lpt_ratio_internal m - -theorem exists_listSchedule_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (τ : Fin n - → Fin m) : - ∃ (π : Equiv.Perm (Fin n)) (σ : Fin n → Fin m), - IsListSchedule (p ∘ π) (σ ∘ π) ∧ makespan p σ ≤ makespan p τ := - exists_listSchedule_le_internal p hp τ - -theorem isLeast_listSchedule_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) : - IsLeast ((fun σ : Fin n → Fin m => makespan p σ) '' - {σ | ∃ π : Equiv.Perm (Fin n), IsListSchedule (p ∘ π) (σ ∘ π)}) (optMakespan m p) := - isLeast_listSchedule_makespan_internal p hp - -theorem nine_five_four_lpt_thirteen : - IsLPTSchedule (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) (![0, 1, 2, 1, 2, 0] : Fin 6 → Fin 3) ∧ - makespan (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) (![0, 1, 2, 1, 2, 0] : Fin 6 → Fin 3) = 13 := - nine_five_four_lpt_thirteen_internal - -theorem nine_five_four_optMakespan : optMakespan 3 (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) = 12 := - nine_five_four_optMakespan_internal - -theorem lpt_third_le_not_optimal : - ∃ (p : Fin 6 → ℝ) (σ : Fin 6 → Fin 3), (∀ j, 0 ≤ p j) ∧ IsLPTSchedule p σ ∧ - (∀ j, optMakespan 3 p ≤ 3 * p j) ∧ optMakespan 3 p < makespan p σ := - lpt_third_le_not_optimal_internal - -theorem lpt_job_position_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : - Antitone p) - (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (τ : Fin n → Fin m) : - (((univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = σ k)).card : ℝ) + 1) * p k ≤ makespan p τ - := - lpt_job_position_le_internal p hp hanti σ hσ k τ - -theorem lpt_bound_of_card {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) - (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (τ : Fin n → Fin m) (i : Fin m) - (hi : load p σ i = makespan p σ) : - ((univ.filter (fun j : Fin n => σ j = i)).card : ℝ) * m * makespan p σ ≤ - (((univ.filter (fun j : Fin n => σ j = i)).card + 1) * m - 1) * makespan p τ := - lpt_bound_of_card_internal p hp σ hσ τ i hi - -theorem lpt_critical_min_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : - Antitone p) - (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (hk : makespan p σ = loadBefore p σ - k (σ k) + p k) - (τ : Fin n → Fin m) : min (makespan p σ) (3 * p k) ≤ makespan p τ := - lpt_critical_min_le_internal p hp hanti σ hσ k hk τ - -theorem lpt_eq_optMakespan_of_critical_third {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p - j) - (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) - (hk : makespan p σ = loadBefore p σ k (σ k) + p k) (h3 : makespan p σ ≤ 3 * p k) : - makespan p σ = optMakespan m p := - lpt_eq_optMakespan_of_critical_third_internal p hp hanti σ hσ k hk h3 - -theorem lpt_eq_bound_structure {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) - (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) - (hk : makespan p σ = loadBefore p σ k (σ k) + p k) (τ : Fin n → Fin m) - (heq : 3 * m * makespan p σ = (4 * m - 1) * makespan p τ) : - 3 * p k = makespan p τ ∧ (∀ i, loadBefore p σ k i = loadBefore p σ k (σ k)) ∧ - (∀ i, load p τ i = makespan p τ) ∧ ∀ j : Fin n, (k : ℕ) < j → p j = 0 := - lpt_eq_bound_structure_internal hm p hp hanti σ hσ k hk τ heq - -theorem lpt_bound_of_other_card {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : - Antitone p) - (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (hk : makespan p σ = loadBefore p σ - k (σ k) + p k) - (i : Fin m) (hi : i ≠ σ k) (q : ℕ) (hq : q ≤ (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j - = i)).card) - (hqm : q + 2 ≤ m) (τ : Fin n → Fin m) : - (q : ℝ) * (m - 1) * makespan p σ ≤ ((q + 1) * (m - 1) - 1) * makespan p τ := - lpt_bound_of_other_card_internal p hp hanti σ hσ k hk i hi q hq hqm τ - -theorem lpt_eq_bound_of_graham {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (a : ℝ) (ha : 0 < a) - (e : Fin n ≃ Fin (2 * m + 1)) (he : ∀ j, p j = a * grahamJobs m (e j)) (σ : Fin n → Fin m) - (hσ : IsLPTSchedule p σ) : 3 * m * makespan p σ = (4 * m - 1) * optMakespan m p := - lpt_eq_bound_of_graham_internal p a ha e he σ hσ - -theorem graham_of_listSchedule_eq_bound {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p : Fin n - → ℝ) - (hp : ∀ j, 0 < p j) (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) - (heq : 3 * m * makespan p σ = (4 * m - 1) * optMakespan m p) : - ∃ (a : ℝ) (h : n = 2 * m + 1), 0 < a ∧ ∀ j, p j = a * grahamJobs m (Fin.cast h j) := - graham_of_listSchedule_eq_bound_internal hm hn p hp hanti σ hσ heq - -theorem graham_of_lpt_eq_bound {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p : Fin n → ℝ) (hp - : ∀ j, 0 < p j) - (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (heq : 3 * m * makespan p σ = (4 * m - 1) * - optMakespan m p) : - ∃ (a : ℝ) (e : Fin n ≃ Fin (2 * m + 1)), 0 < a ∧ ∀ j, p j = a * grahamJobs m (e j) := - graham_of_lpt_eq_bound_internal hm hn p hp σ hσ heq - -theorem lpt_eq_bound_iff_graham {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p : Fin n → ℝ) - (hp : ∀ j, 0 < p j) : - (∃ σ : Fin n → Fin m, IsLPTSchedule p σ ∧ 3 * m * makespan p σ = (4 * m - 1) * optMakespan m - p) ↔ - ∃ (a : ℝ) (e : Fin n ≃ Fin (2 * m + 1)), 0 < a ∧ ∀ j, p j = a * grahamJobs m (e j) := - lpt_eq_bound_iff_graham_internal hm hn p hp - -theorem lpt_lt_bound_of_card_ne {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (hn' : n ≠ 2 * m + 1) - (p : Fin n → ℝ) (hp : ∀ j, 0 < p j) (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) : - 3 * m * makespan p σ < (4 * m - 1) * optMakespan m p := - lpt_lt_bound_of_card_ne_internal hm hn hn' p hp σ hσ - -theorem isLUB_lpt_ratio_of_card {m n : ℕ} [NeZero m] (hn : 2 * m + 1 ≤ n) : - IsLUB {r : ℝ | ∃ (p : Fin n → ℝ) (σ : Fin n → Fin m), (∀ j, 0 < p j) ∧ IsLPTSchedule p σ ∧ - r = makespan p σ / optMakespan m p} (4 / 3 - 1 / (3 * m)) := - isLUB_lpt_ratio_of_card_internal hn - -end GrahamLPT diff --git a/LeanPool/GrahamLPT/Counter.lean b/LeanPool/GrahamLPT/Counter.lean index b447098cb6..c64d2f8479 100644 --- a/LeanPool/GrahamLPT/Counter.lean +++ b/LeanPool/GrahamLPT/Counter.lean @@ -163,7 +163,7 @@ theorem cx_twelve_le_makespan (τ : Fin 6 → Fin 3) : 2, 2, 2`. -/ theorem cx_opt_twelve : optMakespan 3 (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) = 12 := by apply le_antisymm - · refine le_trans (optMakespan_le_internal _ (![0, 1, 1, 2, 2, 2] : Fin 6 → Fin 3)) ?_ + · refine le_trans (optMakespan_le _ (![0, 1, 1, 2, 2, 2] : Fin 6 → Fin 3)) ?_ rw [bs_makespan_le_iff] intro i fin_cases i <;> norm_num [load, Finset.sum_filter, Fin.sum_univ_six] @@ -187,16 +187,16 @@ theorem cx_third_le_not_optimal : · rw [cx_opt_twelve, cx_lpt_thirteen.2] norm_num -theorem nine_five_four_lpt_thirteen_internal : +theorem nine_five_four_lpt_thirteen : IsLPTSchedule (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) (![0, 1, 2, 1, 2, 0] : Fin 6 → Fin 3) ∧ makespan (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) (![0, 1, 2, 1, 2, 0] : Fin 6 → Fin 3) = 13 := cx_lpt_thirteen -theorem nine_five_four_optMakespan_internal : optMakespan 3 (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) = 12 +theorem nine_five_four_optMakespan : optMakespan 3 (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) = 12 := cx_opt_twelve -theorem lpt_third_le_not_optimal_internal : +theorem lpt_third_le_not_optimal : ∃ (p : Fin 6 → ℝ) (σ : Fin 6 → Fin 3), (∀ j, 0 ≤ p j) ∧ IsLPTSchedule p σ ∧ (∀ j, optMakespan 3 p ≤ 3 * p j) ∧ optMakespan 3 p < makespan p σ := cx_third_le_not_optimal diff --git a/LeanPool/GrahamLPT/Equality.lean b/LeanPool/GrahamLPT/Equality.lean index 5a71045b73..b264c7e615 100644 --- a/LeanPool/GrahamLPT/Equality.lean +++ b/LeanPool/GrahamLPT/Equality.lean @@ -534,7 +534,7 @@ theorem eq_count_eq {m : ℕ} (hm : 0 < m) (p : Fin (2 * m + 1) → ℝ) (k : Fi attains Graham's bound against the optimum only for Graham's instance: then `n = 2m + 1` and `p` is a positive multiple of `grahamJobs m`. -/ -theorem graham_of_listSchedule_eq_bound_internal {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p +theorem graham_of_listSchedule_eq_bound {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p : Fin n → ℝ) (hp : ∀ j, 0 < p j) (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (heq : 3 * m * makespan p σ = (4 * m - 1) * optMakespan m p) : @@ -543,10 +543,10 @@ theorem graham_of_listSchedule_eq_bound_internal {m n : ℕ} [NeZero m] (hm : 2 have hmR : (2 : ℝ) ≤ m := by exact_mod_cast hm have hp0 : ∀ j, 0 ≤ p j := fun j => (hp j).le -- Step 1: the optimum and the critical job - obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) p rw [← hτ] at heq have hT : 0 < makespan p τ := - lt_of_lt_of_le (hp ⟨0, hn⟩) (le_makespan_of_nonneg_internal p hp0 τ ⟨0, hn⟩) + lt_of_lt_of_le (hp ⟨0, hn⟩) (le_makespan_of_nonneg p hp0 τ ⟨0, hn⟩) have hCT : makespan p τ < makespan p σ := by by_contra h push Not at h @@ -562,7 +562,7 @@ theorem graham_of_listSchedule_eq_bound_internal {m n : ℕ} [NeZero m] (hm : 2 obtain ⟨k, hk, hload⟩ := bs_exists_last_job p σ i₀ hex have hk' : makespan p σ = loadBefore p σ k (σ k) + p k := by rw [← hi₀, hload, hk] -- Step 2: the structure - obtain ⟨h3, hLB, hloadτ, hzero⟩ := lpt_eq_bound_structure_internal hm p hp0 hanti σ hσ k hk' τ heq + obtain ⟨h3, hLB, hloadτ, hzero⟩ := lpt_eq_bound_structure hm p hp0 hanti σ hσ k hk' τ heq have hlast : ∀ j : Fin n, (j : ℕ) ≤ k := fun j => by by_contra h push Not at h @@ -620,7 +620,7 @@ theorem graham_of_listSchedule_eq_bound_internal {m n : ℕ} [NeZero m] (hm : 2 simp only [Fin.cast_refl, id] have hcount := eq_count_eq hm0 p k t δ hδ hmδ hpk hlast hfib hlat have hg_anti : Antitone (fun j => δ * grahamJobs m j) := fun a b hab => - mul_le_mul_of_nonneg_left (grahamJobs_antitone_internal m hab) hδ.le + mul_le_mul_of_nonneg_left (grahamJobs_antitone m hab) hδ.le exact congrFun (eq_antitone_eq_of_count p (fun j => δ * grahamJobs m j) hanti hg_anti hcount) j end GrahamLPT diff --git a/LeanPool/GrahamLPT/FixedCount.lean b/LeanPool/GrahamLPT/FixedCount.lean index 8c9eedf826..5403dfed23 100644 --- a/LeanPool/GrahamLPT/FixedCount.lean +++ b/LeanPool/GrahamLPT/FixedCount.lean @@ -95,27 +95,31 @@ theorem fc_antitone (m n : ℕ) (ε : ℝ) (hε : ε ≤ m) : Antitone (paddedJo exact h1 · simp only [fc_len_gt m ε a (by omega), fc_len_gt m ε b (by omega), le_refl] -/-- The pairs `j, 2m − 1 − j` of the first `2m` jobs sum to `3m − 1`. -/ +/-- The unpadded jobs agree with Graham's original instance. -/ +theorem paddedJobLength_eq_grahamJobs (m : ℕ) (ε : ℝ) (j : Fin (2 * m + 1)) : + paddedJobLength m ε j = grahamJobs m j := by + by_cases h : (j : ℕ) < 2 * m + · simp only [paddedJobLength, grahamJobs, h, ite_true] + · have hj : (j : ℕ) = 2 * m := by omega + simp only [paddedJobLength, grahamJobs, hj, ite_true] + +/-- Restriction to the original job count removes the small-job tail. -/ +theorem paddedJobs_restrict (m n : ℕ) (ε : ℝ) (hn : 2 * m + 1 ≤ n) : + paddedJobs m n ε ∘ Fin.castLE hn = grahamJobs m := by + funext j + exact paddedJobLength_eq_grahamJobs m ε j + +/-- The pairs `j, 2m − 1 − j` among the original jobs sum to `3m − 1`. -/ theorem fc_pair (m : ℕ) (ε : ℝ) (j : ℕ) (h : j < 2 * m) : paddedJobLength m ε j + paddedJobLength m ε (2 * m - 1 - j) = 3 * m - 1 := by - have key : ∀ a b : ℕ, a + b + 1 = m → - 2 * (m : ℝ) - 1 - (a : ℝ) + (2 * (m : ℝ) - 1 - (b : ℝ)) = 3 * m - 1 := by - intro a b hab - have : (a : ℝ) + b + 1 = m := by exact_mod_cast hab - linarith - rw [fc_len_lt m ε j h, fc_len_lt m ε (2 * m - 1 - j) (by omega)] - exact key _ _ (by omega) + simpa only [← paddedJobLength_eq_grahamJobs m ε] using + tg_pair m ⟨j, by omega⟩ h -/-- The pairs `j, 2m − 3 − j` of the first `2m − 2` jobs sum to `3m`. -/ +/-- The optimal pairs `j, 2m − 3 − j` among the original jobs sum to `3m`. -/ theorem fc_pair' (m : ℕ) (ε : ℝ) (j : ℕ) (h : j < 2 * m - 2) : paddedJobLength m ε j + paddedJobLength m ε (2 * m - 3 - j) = 3 * m := by - have key : ∀ a b : ℕ, a + b + 2 = m → - 2 * (m : ℝ) - 1 - (a : ℝ) + (2 * (m : ℝ) - 1 - (b : ℝ)) = 3 * m := by - intro a b hab - have : (a : ℝ) + b + 2 = m := by exact_mod_cast hab - linarith - rw [fc_len_lt m ε j (by omega), fc_len_lt m ε (2 * m - 3 - j) (by omega)] - exact key _ _ (by omega) + simpa only [← paddedJobLength_eq_grahamJobs m ε] using + tg_pair' m ⟨j, by omega⟩ h /-- The first `2m` jobs sum to `3m² − m`. -/ theorem fc_sum_lt (m n : ℕ) (ε : ℝ) (hn : 2 * m ≤ n) : @@ -141,71 +145,46 @@ theorem fc_sum_lt (m n : ℕ) (ε : ℝ) (hn : 2 * m ≤ n) : index `2m`. -/ theorem fc_exists_prefix_pairing (m n : ℕ) [NeZero m] (ε : ℝ) (hn : 2 * m ≤ n) : ∃ τ : Fin n → Fin m, ∀ i, loadBefore (paddedJobs m n ε) τ (2 * m) i = 3 * m - 1 := by - have hm : 0 < m := NeZero.pos m - refine ⟨fun j => if h : (j : ℕ) < 2 * m then ⟨min (j : ℕ) (2 * m - 1 - j), by omega⟩ - else ⟨0, hm⟩, fun i => ?_⟩ - have hi := i.isLt - unfold loadBefore - have hfib : univ.filter (fun j : Fin n => (j : ℕ) < 2 * m ∧ - (if h : (j : ℕ) < 2 * m then (⟨min (j : ℕ) (2 * m - 1 - j), by omega⟩ : Fin m) else ⟨0, hm⟩) - = i) = - {(⟨i, by omega⟩ : Fin n), ⟨2 * m - 1 - i, by omega⟩} := by - ext j - have hj := j.isLt - simp only [mem_filter, mem_univ, true_and, mem_insert, mem_singleton, Fin.ext_iff] - split_ifs with h1 <;> dsimp only <;> omega - rw [hfib, sum_pair (by rw [Ne, Fin.ext_iff]; dsimp only; omega)] - exact fc_pair m ε i (by omega) + obtain ⟨ρ, hρ⟩ := tg_exists_prefix_pairing m + let τ : Fin n → Fin m := fun j => + if hj : (j : ℕ) < 2 * m then ρ ⟨j, by omega⟩ else 0 + have hsmall : 2 * m ≤ 2 * m + 1 := by omega + have hp : paddedJobs m n ε ∘ Fin.castLE hn = grahamJobs m ∘ Fin.castLE hsmall := by + funext j + exact paddedJobLength_eq_grahamJobs m ε (Fin.castLE hsmall j) + have hτ : τ ∘ Fin.castLE hn = ρ ∘ Fin.castLE hsmall := by + funext j + simp only [τ, Function.comp_apply, Fin.val_castLE, j.isLt, ↓reduceDIte] + congr 1 + refine ⟨τ, fun i => ?_⟩ + rw [← loadBefore_restrict hn _ τ (2 * m) le_rfl i, hp, hτ, + loadBefore_restrict hsmall _ ρ (2 * m) le_rfl i, hρ i] -/-- Every list schedule of the family in its own order has every load `3m − 1` after the first -`2m` jobs (the -key lemma at `T = 3m − 1`, then the sum `m(3m − 1)`). -/ -theorem fc_loadBefore_two_mul (m n : ℕ) [NeZero m] (ε : ℝ) (hε0 : 0 < ε) (hε1 : ε ≤ m) - (hn : 2 * m + 1 ≤ n) (σ : Fin n → Fin m) (hσ : IsListSchedule (paddedJobs m n ε) σ) (i : Fin - m) : - loadBefore (paddedJobs m n ε) σ (2 * m) i = 3 * m - 1 := by - have hm : 0 < m := NeZero.pos m - have hmR : (1 : ℝ) ≤ m := by exact_mod_cast hm - have hp : ∀ j, 0 ≤ paddedJobs m n ε j := fun j => (fc_jobs_pos m n ε hm hε0 j).le - obtain ⟨τ, hτ⟩ := fc_exists_prefix_pairing m n ε (by omega) - have hle : ∀ i', loadBefore (paddedJobs m n ε) σ (2 * m) i' ≤ 3 * m - 1 := by - intro i' - by_cases hex : ∃ j : Fin n, (j : ℕ) < 2 * m ∧ σ j = i' - · obtain ⟨k, hk, hσk, heq⟩ := bs_exists_last_job_before (paddedJobs m n ε) σ (2 * m) i' hex - rw [heq, ← hσk] - apply key_lemma (paddedJobs m n ε) hp (fc_antitone m n ε hε1) σ hσ k τ (3 * m - 1) - · intro i'' - rw [← hτ i''] - exact bs_loadBefore_mono _ hp τ (by omega) i'' - · have := fc_le_len m ε k (by omega) - change (3 : ℝ) * m - 1 < 3 * paddedJobLength m ε k - linarith - · push Not at hex - rw [bs_loadBefore_eq_zero _ σ _ i' hex] - linarith - have htot := fc_sum_lt m n ε (by omega) - have hsum := bs_sum_loadBefore (paddedJobs m n ε) σ (2 * m) - by_contra hne - have hlt : loadBefore (paddedJobs m n ε) σ (2 * m) i < 3 * m - 1 := lt_of_le_of_ne (hle i) hne - have hs : ∑ i', loadBefore (paddedJobs m n ε) σ (2 * m) i' < ∑ _i' : Fin m, (3 * (m : ℝ) - 1) := - sum_lt_sum (fun i' _ => hle i') ⟨i, mem_univ _, hlt⟩ - rw [sum_const, card_univ, Fintype.card_fin, nsmul_eq_mul] at hs - nlinarith +/-- The original prefix loads are unaffected by the lengths of later jobs. -/ +theorem fc_loadBefore_two_mul (m n : ℕ) [NeZero m] (ε : ℝ) + (hn : 2 * m + 1 ≤ n) (σ : Fin n → Fin m) (hσ : IsListSchedule (paddedJobs m n ε) σ) + (i : Fin m) : loadBefore (paddedJobs m n ε) σ (2 * m) i = 3 * m - 1 := by + have hrestricted := IsListSchedule.restrict hn (paddedJobs m n ε) σ hσ + rw [paddedJobs_restrict m n ε hn] at hrestricted + have hload := tg_loadBefore_two_mul m (σ ∘ Fin.castLE hn) hrestricted i + rw [← paddedJobs_restrict m n ε hn, + loadBefore_restrict hn (paddedJobs m n ε) σ (2 * m) (by omega) i] at hload + exact hload /-- Every list schedule of the family in its own order has makespan at least `4m − 1`: the job `2m`, of length `m`, lands on a machine of load `3m − 1`. -/ -theorem fc_le_makespan_listSchedule (m n : ℕ) [NeZero m] (ε : ℝ) (hε0 : 0 < ε) (hε1 : ε ≤ m) +theorem fc_le_makespan_listSchedule (m n : ℕ) [NeZero m] (ε : ℝ) (hε0 : 0 < ε) (hn : 2 * m + 1 ≤ n) (σ : Fin n → Fin m) (hσ : IsListSchedule (paddedJobs m n ε) σ) : 4 * (m : ℝ) - 1 ≤ makespan (paddedJobs m n ε) σ := by have hm : 0 < m := NeZero.pos m have hp : ∀ j, 0 ≤ paddedJobs m n ε j := fun j => (fc_jobs_pos m n ε hm hε0 j).le obtain ⟨k, hk⟩ : ∃ k : Fin n, (k : ℕ) = 2 * m := ⟨⟨2 * m, by omega⟩, rfl⟩ - have h1 := fc_loadBefore_two_mul m n ε hε0 hε1 hn σ hσ (σ k) + have h1 := fc_loadBefore_two_mul m n ε hn σ hσ (σ k) have h2 := bs_loadBefore_succ (paddedJobs m n ε) σ k (σ k) rw [hk, ite_eq_left rfl] at h2 have h3 := bs_loadBefore_le_load (paddedJobs m n ε) hp σ (2 * m + 1) (σ k) - have h4 := load_le_makespan_internal (paddedJobs m n ε) σ (σ k) + have h4 := load_le_makespan (paddedJobs m n ε) σ (σ k) have h5 : paddedJobs m n ε k = m := by change paddedJobLength m ε k = m rw [hk] @@ -227,8 +206,8 @@ theorem fc_le_makespan_lpt (m n : ℕ) [NeZero m] (ε : ℝ) (hε0 : 0 < ε) (h obtain ⟨π, hanti, hls⟩ := hσ have hc := fc_comp_eq m n ε hε1 π hanti rw [hc] at hls - have h1 := fc_le_makespan_listSchedule m n ε hε0 hε1 hn (σ ∘ π) hls - rw [← makespan_comp_internal (paddedJobs m n ε) σ π, hc] + have h1 := fc_le_makespan_listSchedule m n ε hε0 hn (σ ∘ π) hls + rw [← makespan_comp (paddedJobs m n ε) σ π, hc] exact h1 /-- The pairing `j ↦ min (j, 2m − 3 − j)` of the first `2m − 2` jobs, the three jobs of length `m` @@ -312,14 +291,14 @@ theorem fc_exists_opt (m n : ℕ) [NeZero m] (ε : ℝ) (hε0 : 0 ≤ ε) (hn : theorem fc_optMakespan_le (m n : ℕ) [NeZero m] (ε : ℝ) (hε0 : 0 ≤ ε) (hn : 2 * m + 1 ≤ n) : optMakespan m (paddedJobs m n ε) ≤ 3 * m + n * ε := by obtain ⟨τ, hτ⟩ := fc_exists_opt m n ε hε0 hn - exact (optMakespan_le_internal _ τ).trans ((bs_makespan_le_iff _ _ _).2 hτ) + exact (optMakespan_le _ τ).trans ((bs_makespan_le_iff _ _ _).2 hτ) /-- A positive instance with a job has a positive optimum. -/ theorem fc_optMakespan_pos {m n : ℕ} [NeZero m] (hn : 0 < n) (p : Fin n → ℝ) (hp : ∀ j, 0 < p j) : 0 < optMakespan m p := by - obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) p rw [← hτ] - exact lt_of_lt_of_le (hp ⟨0, hn⟩) (le_makespan_of_nonneg_internal p (fun j => (hp j).le) τ ⟨0, + exact lt_of_lt_of_le (hp ⟨0, hn⟩) (le_makespan_of_nonneg p (fun j => (hp j).le) τ ⟨0, hn⟩) /-- For every fixed number `n ≥ 2m + 1` of jobs, Graham's constant `4/3 − 1/(3m)` is still the @@ -327,7 +306,7 @@ supremum of `C(σ)/optMakespan` over the LPT schedules of the positive instances with `n` jobs (for `m ≥ 2` it is attained only at `n = 2m + 1`, `lpt_lt_bound_of_card_ne`). -/ -theorem isLUB_lpt_ratio_of_card_internal {m n : ℕ} [NeZero m] (hn : 2 * m + 1 ≤ n) : +theorem isLUB_lpt_ratio_of_card {m n : ℕ} [NeZero m] (hn : 2 * m + 1 ≤ n) : IsLUB {r : ℝ | ∃ (p : Fin n → ℝ) (σ : Fin n → Fin m), (∀ j, 0 < p j) ∧ IsLPTSchedule p σ ∧ r = makespan p σ / optMakespan m p} (4 / 3 - 1 / (3 * m)) := by have hm : 0 < m := NeZero.pos m @@ -340,7 +319,7 @@ theorem isLUB_lpt_ratio_of_card_internal {m n : ℕ} [NeZero m] (hn : 2 * m + 1 rintro r ⟨p, σ, hp, hσ, rfl⟩ have hopt := fc_optMakespan_pos (m := m) hn0 p hp rw [div_le_iff₀ hopt] - exact lpt_le_optMakespan_internal p (fun j => (hp j).le) σ hσ + exact lpt_le_optMakespan p (fun j => (hp j).le) σ hσ · rw [mem_lowerBounds] intro b hb rw [mem_upperBounds] at hb @@ -356,7 +335,7 @@ theorem isLUB_lpt_ratio_of_card_internal {m n : ℕ} [NeZero m] (hn : 2 * m + 1 have hε1 : ε ≤ 1 := by rw [hε, div_le_one hden]; linarith only [hbn] have hεm : ε ≤ m := by linarith only [hε1, hmR] have hεeq : ε * (D + |b| * n + 1) = D := by rw [hε]; exact div_mul_cancel₀ D hden.ne' - obtain ⟨σ, hσ⟩ := exists_isLPTSchedule_internal (m := m) (paddedJobs m n ε) + obtain ⟨σ, hσ⟩ := exists_isLPTSchedule (m := m) (paddedJobs m n ε) have hpos : ∀ j, 0 < paddedJobs m n ε j := fc_jobs_pos m n ε hm hε0 have hmem := hb _ ⟨paddedJobs m n ε, σ, hpos, hσ, rfl⟩ have hopt := fc_optMakespan_pos (m := m) hn0 _ hpos diff --git a/LeanPool/GrahamLPT/GrahamScaled.lean b/LeanPool/GrahamLPT/GrahamScaled.lean index 0d42c10325..858aac1cc2 100644 --- a/LeanPool/GrahamLPT/GrahamScaled.lean +++ b/LeanPool/GrahamLPT/GrahamScaled.lean @@ -56,12 +56,12 @@ theorem gs_makespan_smul {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (a : ℝ) (h theorem gs_optMakespan_smul {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (a : ℝ) (ha : 0 ≤ a) : optMakespan m (fun j => a * p j) = a * optMakespan m p := by apply le_antisymm - · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) p rw [← hτ, ← gs_makespan_smul p a ha τ] - exact optMakespan_le_internal _ τ - · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) (fun j => a * p j) + exact optMakespan_le _ τ + · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) (fun j => a * p j) rw [← hτ, gs_makespan_smul p a ha τ] - exact mul_le_mul_of_nonneg_left (optMakespan_le_internal p τ) ha + exact mul_le_mul_of_nonneg_left (optMakespan_le p τ) ha /-- A list schedule of `p` is a list schedule of `a · p` for `a > 0`, and conversely. -/ theorem gs_isListSchedule_smul_iff {m n : ℕ} (p : Fin n → ℝ) (a : ℝ) (ha : 0 < a) (σ : Fin n → Fin @@ -81,22 +81,22 @@ theorem gs_isListSchedule_smul_iff {m n : ℕ} (p : Fin n → ℝ) (a : ℝ) (ha theorem gs_optMakespan_comp {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (π : Equiv.Perm (Fin n)) : optMakespan m (p ∘ π) = optMakespan m p := by apply le_antisymm - · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p - rw [← hτ, ← makespan_comp_internal p τ π] - exact optMakespan_le_internal _ (τ ∘ π) - · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) (p ∘ π) + · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) p + rw [← hτ, ← makespan_comp p τ π] + exact optMakespan_le _ (τ ∘ π) + · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) (p ∘ π) have hp : (p ∘ π) ∘ π.symm = p := by funext j simp only [Function.comp_apply, Equiv.apply_symm_apply] - have h := makespan_comp_internal (p ∘ π) τ π.symm + have h := makespan_comp (p ∘ π) τ π.symm rw [hp] at h rw [← hτ, ← h] - exact optMakespan_le_internal _ (τ ∘ π.symm) + exact optMakespan_le _ (τ ∘ π.symm) /-- Every positive multiple of Graham's instance, in any order, attains the bound: every LPT schedule `σ` satisfies `3m · C(σ) = (4m − 1) · optMakespan`. -/ -theorem lpt_eq_bound_of_graham_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (a : ℝ) (ha : 0 < a) +theorem lpt_eq_bound_of_graham {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (a : ℝ) (ha : 0 < a) (e : Fin n ≃ Fin (2 * m + 1)) (he : ∀ j, p j = a * grahamJobs m (e j)) (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) : 3 * m * makespan p σ = (4 * m - 1) * optMakespan m p := by have hn : n = 2 * m + 1 := by @@ -122,16 +122,16 @@ theorem lpt_eq_bound_of_graham_internal {m n : ℕ} [NeZero m] (p : Fin n → have hlpt : IsLPTSchedule (grahamJobs m) (σ ∘ e.symm) := ⟨π.trans e, hanti', by rw [hcomp]; exact hls'⟩ have h1 : makespan (grahamJobs m) (σ ∘ e.symm) = 4 * m - 1 := - grahamJobs_lpt_makespan_internal m _ hlpt + grahamJobs_lpt_makespan m _ hlpt have h2 : makespan p σ = a * makespan (grahamJobs m) (σ ∘ e.symm) := by have hσe : (σ ∘ e.symm) ∘ e = σ := by funext j simp only [Function.comp_apply, Equiv.symm_apply_apply] rw [hpe, gs_makespan_smul (grahamJobs m ∘ e) a ha.le σ, - ← makespan_comp_internal (grahamJobs m) (σ ∘ e.symm) e, hσe] + ← makespan_comp (grahamJobs m) (σ ∘ e.symm) e, hσe] have h3 : optMakespan m p = a * (3 * m) := by rw [hpe, gs_optMakespan_smul (grahamJobs m ∘ e) a ha.le, gs_optMakespan_comp (grahamJobs m) e, - grahamJobs_optMakespan_internal] + grahamJobs_optMakespan] rw [h2, h3, h1] ring diff --git a/LeanPool/GrahamLPT/Imports.lean b/LeanPool/GrahamLPT/Imports.lean index 386198bc38..96a6601fa6 100644 --- a/LeanPool/GrahamLPT/Imports.lean +++ b/LeanPool/GrahamLPT/Imports.lean @@ -10,7 +10,6 @@ public import LeanPool.GrahamLPT public import LeanPool.GrahamLPT.Basic public import LeanPool.GrahamLPT.Certificates public import LeanPool.GrahamLPT.CoffmanSethi -public import LeanPool.GrahamLPT.Contracts public import LeanPool.GrahamLPT.Counter public import LeanPool.GrahamLPT.Defs public import LeanPool.GrahamLPT.Equality diff --git a/LeanPool/GrahamLPT/Key.lean b/LeanPool/GrahamLPT/Key.lean index 66a654733e..315a407b8f 100644 --- a/LeanPool/GrahamLPT/Key.lean +++ b/LeanPool/GrahamLPT/Key.lean @@ -16,8 +16,6 @@ import Mathlib.Tactic.Positivity.Finset # Key The key lemma by counting, and the optimality of LPT when every job exceeds a third of the optimum. -Helpers carry the prefix `key_`; the `_internal` twins of the Challenge theorems are closed in -`Contracts.lean`. -/ @[expose] public section @@ -39,7 +37,7 @@ theorem key_card_mul_le_sum {n : ℕ} (p : Fin n → ℝ) (hanti : Antitone p) ( exact Fin.le_iff_val_le_val.mpr (by omega) simpa [Finset.sum_const, nsmul_eq_mul] using h -/-- The key lemma (PROOF.md §3): `p` nonincreasing and nonnegative, `σ` a list schedule, `τ` any +/-- The counting lemma: `p` nonincreasing and nonnegative, `σ` a list schedule, `τ` any assignment whose loads from the jobs of index `≤ k` are at most `T`, and `T < 3 p_k`: then the machine of `k` ends by `T`. -/ @@ -182,30 +180,30 @@ theorem key_optimal_sorted {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ rw [hload] subst hk refine key_lemma p hp hanti σ hσ k τ (makespan p τ) (fun i' => ?_) (h k) - exact (bs_loadBefore_le_load p hp τ _ i').trans (load_le_makespan_internal p τ i') + exact (bs_loadBefore_le_load p hp τ _ i').trans (load_le_makespan p τ i') · push Not at hi rw [bs_load_eq_zero p σ i hi] exact bs_makespan_nonneg p hp τ /-- When every job is longer than a third of the makespan of `τ`, every LPT schedule is at least as good as `τ`. -/ -theorem lpt_optimal_of_third_lt_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) +theorem lpt_optimal_of_third_lt {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (τ : Fin n → Fin m) (h : ∀ j, makespan p τ < 3 * p j) : makespan p σ ≤ makespan p τ := by obtain ⟨π, hπ, hlist⟩ := hσ have hs := key_optimal_sorted (p ∘ π) (fun j => hp (π j)) hπ (σ ∘ π) hlist (τ ∘ π) - (fun j => by rw [makespan_comp_internal]; exact h (π j)) - rwa [makespan_comp_internal, makespan_comp_internal] at hs + (fun j => by rw [makespan_comp]; exact h (π j)) + rwa [makespan_comp, makespan_comp] at hs /-- LPT is optimal when every job is longer than a third of the optimal makespan. -/ -theorem lpt_eq_optMakespan_of_third_lt_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 +theorem lpt_eq_optMakespan_of_third_lt {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (h : ∀ j, optMakespan m p < 3 * p j) : makespan p σ = optMakespan m p := by - obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) p apply le_antisymm · rw [← hτ] - exact lpt_optimal_of_third_lt_internal p hp σ hσ τ (fun j => by rw [hτ]; exact h j) - · exact optMakespan_le_internal p σ + exact lpt_optimal_of_third_lt p hp σ hσ τ (fun j => by rw [hτ]; exact h j) + · exact optMakespan_le p σ end GrahamLPT diff --git a/LeanPool/GrahamLPT/LPTBound.lean b/LeanPool/GrahamLPT/LPTBound.lean index c4e3346fd9..6df92a2f3e 100644 --- a/LeanPool/GrahamLPT/LPTBound.lean +++ b/LeanPool/GrahamLPT/LPTBound.lean @@ -16,8 +16,6 @@ import Mathlib.Tactic.Positivity.Finset # LPTBound Graham's 1969 bound for LPT. -Helpers carry the prefix `lb2_`; the `_internal` twins of the Challenge theorems are closed in -`Contracts.lean`. -/ @[expose] public section @@ -43,11 +41,11 @@ theorem lb2_bound_sorted {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, rcases le_or_gt (3 * p k) (makespan p τ) with h3 | h3 · have h1 := bs_mul_loadBefore_le p σ hσ k have h2 := bs_sum_filter_add_le p hp k - have h4 := sum_le_mul_makespan_internal p τ + have h4 := sum_le_mul_makespan p τ have h5 := mul_nonneg (sub_nonneg.2 hm) (sub_nonneg.2 h3) nlinarith · have hkey := key_lemma p hp hanti σ hσ k τ (makespan p τ) - (fun i => (bs_loadBefore_le_load p hp τ _ i).trans (load_le_makespan_internal p τ i)) h3 + (fun i => (bs_loadBefore_le_load p hp τ _ i).trans (load_le_makespan p τ i)) h3 have h5 := mul_nonneg (sub_nonneg.2 hm) hτ0 have hm0 : (0 : ℝ) ≤ m := by linarith have h6 := mul_le_mul_of_nonneg_left hkey (by linarith : (0 : ℝ) ≤ 3 * m) @@ -60,19 +58,19 @@ theorem lb2_bound_sorted {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, /-- Graham's bound for LPT: for nonnegative lengths, every LPT schedule `σ` and every assignment `τ` satisfy `3m · C(σ) ≤ (4m − 1) · C(τ)`. -/ -theorem lpt_bound_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) +theorem lpt_bound {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (τ : Fin n → Fin m) : 3 * (m : ℝ) * makespan p σ ≤ (4 * m - 1) * makespan p τ := by obtain ⟨π, hanti, hl⟩ := hσ have h := lb2_bound_sorted (p ∘ π) (fun j => hp _) hanti (σ ∘ π) hl (τ ∘ π) - rwa [makespan_comp_internal, makespan_comp_internal] at h + rwa [makespan_comp, makespan_comp] at h /-- Every LPT schedule is within the factor `4/3 − 1/(3m)` of the optimum. -/ -theorem lpt_le_optMakespan_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) +theorem lpt_le_optMakespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) : makespan p σ ≤ (4 / 3 - 1 / (3 * m)) * optMakespan m p := by - obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p - have h := lpt_bound_internal p hp σ hσ τ + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) p + have h := lpt_bound p hp σ hσ τ rw [hτ] at h have hm : (0 : ℝ) < m := by have := NeZero.ne m diff --git a/LeanPool/GrahamLPT/LPTForm.lean b/LeanPool/GrahamLPT/LPTForm.lean index 3c0601ad5c..e33397881b 100644 --- a/LeanPool/GrahamLPT/LPTForm.lean +++ b/LeanPool/GrahamLPT/LPTForm.lean @@ -32,17 +32,17 @@ open Finset instance attains Graham's bound against the optimum only when the instance is a positive multiple of Graham's `2m + 1` jobs in some order. -/ -theorem graham_of_lpt_eq_bound_internal {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p : Fin n +theorem graham_of_lpt_eq_bound {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p : Fin n → ℝ) (hp : ∀ j, 0 < p j) (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) (heq : 3 * m * makespan p σ = (4 * m - 1) * optMakespan m p) : ∃ (a : ℝ) (e : Fin n ≃ Fin (2 * m + 1)), 0 < a ∧ ∀ j, p j = a * grahamJobs m (e j) := by obtain ⟨π, hanti, hls⟩ := hσ have heq' : 3 * m * makespan (p ∘ π) (σ ∘ π) = (4 * m - 1) * optMakespan m (p ∘ π) := by - rw [makespan_comp_internal, gs_optMakespan_comp] + rw [makespan_comp, gs_optMakespan_comp] exact heq obtain ⟨a, h, ha, hpa⟩ := - graham_of_listSchedule_eq_bound_internal hm hn (p ∘ π) (fun j => hp (π j)) hanti (σ ∘ π) hls + graham_of_listSchedule_eq_bound hm hn (p ∘ π) (fun j => hp (π j)) hanti (σ ∘ π) hls heq' refine ⟨a, π.symm.trans (finCongr h), ha, fun j => ?_⟩ have hj := hpa (π.symm j) @@ -55,7 +55,7 @@ schedule attains Graham's bound `3m · C(σ) = (4m − 1) · optMakespan` if and is a positive multiple of Graham's `2m + 1` jobs in some order (and then every LPT schedule attains it, `lpt_eq_bound_of_graham`). -/ -theorem lpt_eq_bound_iff_graham_internal {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p : Fin n +theorem lpt_eq_bound_iff_graham {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (p : Fin n → ℝ) (hp : ∀ j, 0 < p j) : (∃ σ : Fin n → Fin m, IsLPTSchedule p σ ∧ 3 * m * makespan p σ = (4 * m - 1) * optMakespan m @@ -63,23 +63,23 @@ theorem lpt_eq_bound_iff_graham_internal {m n : ℕ} [NeZero m] (hm : 2 ≤ m) ( ∃ (a : ℝ) (e : Fin n ≃ Fin (2 * m + 1)), 0 < a ∧ ∀ j, p j = a * grahamJobs m (e j) := by constructor · rintro ⟨σ, hσ, heq⟩ - exact graham_of_lpt_eq_bound_internal hm hn p hp σ hσ heq + exact graham_of_lpt_eq_bound hm hn p hp σ hσ heq · rintro ⟨a, e, ha, he⟩ - obtain ⟨σ, hσ⟩ := exists_isLPTSchedule_internal (m := m) p - exact ⟨σ, hσ, lpt_eq_bound_of_graham_internal p a ha e he σ hσ⟩ + obtain ⟨σ, hσ⟩ := exists_isLPTSchedule (m := m) p + exact ⟨σ, hσ, lpt_eq_bound_of_graham p a ha e he σ hσ⟩ /-- With any number of jobs other than `2m + 1`, no LPT schedule of a nonempty positive instance on `m ≥ 2` machines attains Graham's bound: the inequality is strict. -/ -theorem lpt_lt_bound_of_card_ne_internal {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (hn' : n ≠ +theorem lpt_lt_bound_of_card_ne {m n : ℕ} [NeZero m] (hm : 2 ≤ m) (hn : 0 < n) (hn' : n ≠ 2 * m + 1) (p : Fin n → ℝ) (hp : ∀ j, 0 < p j) (σ : Fin n → Fin m) (hσ : IsLPTSchedule p σ) : 3 * m * makespan p σ < (4 * m - 1) * optMakespan m p := by - obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p - have hle := lpt_bound_internal p (fun j => (hp j).le) σ hσ τ + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) p + have hle := lpt_bound p (fun j => (hp j).le) σ hσ τ rw [hτ] at hle refine lt_of_le_of_ne hle fun heq => hn' ?_ - obtain ⟨_, e, _, _⟩ := graham_of_lpt_eq_bound_internal hm hn p hp σ hσ heq + obtain ⟨_, e, _, _⟩ := graham_of_lpt_eq_bound hm hn p hp σ hσ heq simpa using Fintype.card_congr e end GrahamLPT diff --git a/LeanPool/GrahamLPT/ListBound.lean b/LeanPool/GrahamLPT/ListBound.lean index f4af0dc584..56c948b570 100644 --- a/LeanPool/GrahamLPT/ListBound.lean +++ b/LeanPool/GrahamLPT/ListBound.lean @@ -15,8 +15,6 @@ import Mathlib.Tactic.Positivity.Finset # ListBound Graham's 1966 bound for list scheduling. -Helpers carry the prefix `lb_`; the `_internal` twins of the Challenge theorems are closed in -`Contracts.lean`. -/ @[expose] public section @@ -37,7 +35,7 @@ theorem lb_mul_le {m n : ℕ} (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : /-- Graham's bound for list scheduling: for nonnegative lengths, every list schedule `σ` and every assignment `τ` satisfy `m · C(σ) ≤ (2m − 1) · C(τ)`. -/ -theorem listSchedule_bound_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) +theorem listSchedule_bound {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (τ : Fin n → Fin m) : (m : ℝ) * makespan p σ ≤ (2 * m - 1) * makespan p τ := by have hm : (1 : ℝ) ≤ m := Nat.one_le_cast.mpr (NeZero.pos m) @@ -47,8 +45,8 @@ theorem listSchedule_bound_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) ( · obtain ⟨k, hk, hload⟩ := bs_exists_last_job p σ i h subst hk have hmul := lb_mul_le p hp σ hσ k - have hsum := sum_le_mul_makespan_internal p τ - have hpk := le_makespan_of_nonneg_internal p hp τ k + have hsum := sum_le_mul_makespan p τ + have hpk := le_makespan_of_nonneg p hp τ k have hpk' : ((m : ℝ) - 1) * p k ≤ ((m : ℝ) - 1) * makespan p τ := mul_le_mul_of_nonneg_left hpk (by linarith) rw [← hi, hload] @@ -59,13 +57,13 @@ theorem listSchedule_bound_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) ( exact mul_nonneg (by linarith) hτ0 /-- Every list schedule is within the factor `2 − 1/m` of the optimum. -/ -theorem listSchedule_le_optMakespan_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p +theorem listSchedule_le_optMakespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) : makespan p σ ≤ (2 - 1 / m) * optMakespan m p := by have hm : (0 : ℝ) < m := Nat.cast_pos.mpr (NeZero.pos m) - obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p - have hb := listSchedule_bound_internal p hp σ hσ τ + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) p + have hb := listSchedule_bound p hp σ hσ τ rw [hτ] at hb have heq : (2 - 1 / (m : ℝ)) * optMakespan m p = (2 * m - 1) * optMakespan m p / m := by field_simp diff --git a/LeanPool/GrahamLPT/ListOptimum.lean b/LeanPool/GrahamLPT/ListOptimum.lean index 66898fe9f0..b938b279bb 100644 --- a/LeanPool/GrahamLPT/ListOptimum.lean +++ b/LeanPool/GrahamLPT/ListOptimum.lean @@ -186,7 +186,7 @@ theorem lo_exists_listSchedule_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp exact (bs_loadBefore_le_load p hp τ _ _).trans (bs_load_le_makespan p τ _) set π := Tuple.sort s with hπ have hmono : Monotone (s ∘ π) := Tuple.monotone_sort s - obtain ⟨σ', hσ'⟩ := exists_isListSchedule_internal (m := m) (p ∘ π) + obtain ⟨σ', hσ'⟩ := exists_isListSchedule (m := m) (p ∘ π) have e : (σ' ∘ ⇑π.symm) ∘ ⇑π = σ' := by funext j simp @@ -196,7 +196,7 @@ theorem lo_exists_listSchedule_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp · have key := lo_makespan_le (p ∘ π) (fun j => hp (π j)) σ' hσ' (τ ∘ π) (s ∘ π) hmono (fun j => hs0 (π j)) (fun a b hab he => hdisj (π a) (π b) (π.injective.ne hab) he) (makespan p τ) (bs_makespan_nonneg p hp τ) (fun j => hC (π j)) - rw [← makespan_comp_internal p (σ' ∘ π.symm) π, e] + rw [← makespan_comp p (σ' ∘ π.symm) π, e] exact key /-- The optimal makespan is the least makespan over the list schedules in all orders (Graham's @@ -205,21 +205,21 @@ theorem lo_optMakespan_eq {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j IsLeast ((fun σ : Fin n → Fin m => makespan p σ) '' {σ | ∃ π : Equiv.Perm (Fin n), IsListSchedule (p ∘ π) (σ ∘ π)}) (optMakespan m p) := by constructor - · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) p + · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) p obtain ⟨π, σ, hσ, hle⟩ := lo_exists_listSchedule_le p hp τ - refine ⟨σ, ⟨π, hσ⟩, le_antisymm ?_ (optMakespan_le_internal p σ)⟩ + refine ⟨σ, ⟨π, hσ⟩, le_antisymm ?_ (optMakespan_le p σ)⟩ rw [← hτ] exact hle · rintro c ⟨σ, -, rfl⟩ - exact optMakespan_le_internal p σ + exact optMakespan_le p σ -theorem exists_listSchedule_le_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) +theorem exists_listSchedule_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (τ : Fin n → Fin m) : ∃ (π : Equiv.Perm (Fin n)) (σ : Fin n → Fin m), IsListSchedule (p ∘ π) (σ ∘ π) ∧ makespan p σ ≤ makespan p τ := lo_exists_listSchedule_le p hp τ -theorem isLeast_listSchedule_makespan_internal {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ +theorem isLeast_listSchedule_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) : IsLeast ((fun σ : Fin n → Fin m => makespan p σ) '' {σ | ∃ π : Equiv.Perm (Fin n), IsListSchedule (p ∘ π) (σ ∘ π)}) (optMakespan m p) := diff --git a/LeanPool/GrahamLPT/OptList.lean b/LeanPool/GrahamLPT/OptList.lean index c756cbc3fd..24f69ffeb0 100644 --- a/LeanPool/GrahamLPT/OptList.lean +++ b/LeanPool/GrahamLPT/OptList.lean @@ -16,8 +16,6 @@ import Mathlib.Tactic.Positivity.Finset The order `grahamOrder` of Graham's family, its lengths, and the optimum attained by a list schedule in that order. -Helpers carry the prefix `ol_`; the `_internal` twins of the Challenge theorems are closed in -`Contracts.lean`. -/ @[expose] public section @@ -27,7 +25,7 @@ namespace GrahamLPT open Finset /-- The order `grahamOrder m` is a permutation of the `2m + 1` jobs. -/ -theorem grahamOrder_bijective_internal (m : ℕ) : Function.Bijective (grahamOrder m) := by +theorem grahamOrder_bijective (m : ℕ) : Function.Bijective (grahamOrder m) := by rw [← Finite.injective_iff_bijective] intro a b h have ha := a.isLt @@ -100,7 +98,7 @@ theorem ol_q (m : ℕ) [NeZero m] (j : Fin (2 * m + 1)) : grahamJobs m (grahamOr `2m − 1, …, m + 1, m, m, 2m − 1, …, m + 1, m`: position `i` holds length `2m − 1 − i` for `i < m − 1`, `m` for `i = m − 1` and `i = m`, `3m − i` for `m < i < 2m`, and `m` for `i = 2m`. -/ -theorem grahamJobs_grahamOrder_internal (m : ℕ) (i : Fin (2 * m + 1)) : +theorem grahamJobs_grahamOrder (m : ℕ) (i : Fin (2 * m + 1)) : grahamJobs m (grahamOrder m i) = if (i : ℕ) < m - 1 then 2 * (m : ℝ) - 1 - ((i : ℕ) : ℝ) else if (i : ℕ) ≤ m then (m : ℝ) @@ -203,18 +201,18 @@ theorem ol_makespan (m : ℕ) [NeZero m] : intro i rw [ol_load] · rw [← ol_load m ⟨0, NeZero.pos m⟩] - exact load_le_makespan_internal _ _ _ + exact load_le_makespan _ _ _ /-- The optimum `3m` of Graham's instance is attained by a list schedule in the order `grahamOrder m`, that is `2m − 1, …, m + 1, m, m, 2m − 1, …, m + 1, m` (`grahamJobs_grahamOrder`): some assignment `σ` is a list schedule of the jobs taken in that order and has makespan `3m`. -/ -theorem grahamJobs_exists_optimal_listSchedule_internal (m : ℕ) [NeZero m] : +theorem grahamJobs_exists_optimal_listSchedule (m : ℕ) [NeZero m] : ∃ σ : Fin (2 * m + 1) → Fin m, IsListSchedule (grahamJobs m ∘ grahamOrder m) (σ ∘ grahamOrder m) ∧ makespan (grahamJobs m) σ = 3 * m := by - let π : Equiv.Perm (Fin (2 * m + 1)) := Equiv.ofBijective _ (grahamOrder_bijective_internal m) + let π : Equiv.Perm (Fin (2 * m + 1)) := Equiv.ofBijective _ (grahamOrder_bijective m) have hπ : (π : Fin (2 * m + 1) → Fin (2 * m + 1)) = grahamOrder m := rfl have hσ : (optimalMachine m ∘ π.symm) ∘ π = optimalMachine m := by funext j @@ -222,7 +220,7 @@ theorem grahamJobs_exists_optimal_listSchedule_internal (m : ℕ) [NeZero m] : refine ⟨optimalMachine m ∘ π.symm, ?_, ?_⟩ · rw [← hπ, hσ, hπ] exact ol_isListSchedule m - · rw [← makespan_comp_internal (grahamJobs m) (optimalMachine m ∘ π.symm) π, hσ, hπ] + · rw [← makespan_comp (grahamJobs m) (optimalMachine m ∘ π.symm) π, hσ, hπ] exact ol_makespan m end GrahamLPT diff --git a/LeanPool/GrahamLPT/Ratio.lean b/LeanPool/GrahamLPT/Ratio.lean index 08470b740e..f20a6a64c5 100644 --- a/LeanPool/GrahamLPT/Ratio.lean +++ b/LeanPool/GrahamLPT/Ratio.lean @@ -19,8 +19,6 @@ import Mathlib.Tactic.Positivity.Finset # Ratio The least constants, `2 − 1/m` and `4/3 − 1/(3m)`. -Helpers carry the prefix `rt_`; the `_internal` twins of the Challenge theorems are closed in -`Contracts.lean`. -/ @[expose] public section @@ -31,28 +29,28 @@ open Finset /-- `2 − 1/m` is the least constant `c` with `C(σ) ≤ c · C(τ)` for every list schedule `σ` of every nonnegative instance on `m` machines and every assignment `τ`. -/ -theorem isLeast_listSchedule_ratio_internal (m : ℕ) [NeZero m] : +theorem isLeast_listSchedule_ratio (m : ℕ) [NeZero m] : IsLeast {c : ℝ | ∀ (n : ℕ) (p : Fin n → ℝ) (σ τ : Fin n → Fin m), (∀ j, 0 ≤ p j) → IsListSchedule p σ → makespan p σ ≤ c * makespan p τ} (2 - 1 / m) := by have hm : (0 : ℝ) < m := by exact_mod_cast Nat.pos_of_ne_zero (NeZero.ne m) have hc : (2 : ℝ) - 1 / m = (2 * m - 1) / m := by field_simp refine ⟨?_, ?_⟩ · intro n p σ τ hp hσ - have h := listSchedule_bound_internal p hp σ hσ τ + have h := listSchedule_bound p hp σ hσ τ rw [hc, div_mul_eq_mul_div, le_div_iff₀ hm] linarith · intro c hc' - obtain ⟨σ, hσ⟩ := exists_isListSchedule_internal (m := m) (unitJobs m) - obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) (unitJobs m) + obtain ⟨σ, hσ⟩ := exists_isListSchedule (m := m) (unitJobs m) + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) (unitJobs m) have h := hc' _ (unitJobs m) σ τ (tl_unitJobs_nonneg m) hσ - rw [unitJobs_listSchedule_makespan_internal m σ hσ, hτ, unitJobs_optMakespan_internal m] at h + rw [unitJobs_listSchedule_makespan m σ hσ, hτ, unitJobs_optMakespan m] at h rw [hc, div_le_iff₀ hm] linarith /-- `4/3 − 1/(3m)` is the least constant `c` with `C(σ) ≤ c · C(τ)` for every LPT schedule `σ` of every nonnegative instance on `m` machines and every assignment `τ`. -/ -theorem isLeast_lpt_ratio_internal (m : ℕ) [NeZero m] : +theorem isLeast_lpt_ratio (m : ℕ) [NeZero m] : IsLeast {c : ℝ | ∀ (n : ℕ) (p : Fin n → ℝ) (σ τ : Fin n → Fin m), (∀ j, 0 ≤ p j) → IsLPTSchedule p σ → makespan p σ ≤ c * makespan p τ} (4 / 3 - 1 / (3 * m)) := by have hm : (0 : ℝ) < m := by exact_mod_cast Nat.pos_of_ne_zero (NeZero.ne m) @@ -60,14 +58,14 @@ theorem isLeast_lpt_ratio_internal (m : ℕ) [NeZero m] : have hc : (4 : ℝ) / 3 - 1 / (3 * m) = (4 * m - 1) / (3 * m) := by field_simp refine ⟨?_, ?_⟩ · intro n p σ τ hp hσ - have h := lpt_bound_internal p hp σ hσ τ + have h := lpt_bound p hp σ hσ τ rw [hc, div_mul_eq_mul_div, le_div_iff₀ hm3] linarith · intro c hc' - obtain ⟨σ, hσ⟩ := exists_isLPTSchedule_internal (m := m) (grahamJobs m) - obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) (grahamJobs m) + obtain ⟨σ, hσ⟩ := exists_isLPTSchedule (m := m) (grahamJobs m) + obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) (grahamJobs m) have h := hc' _ (grahamJobs m) σ τ (tg_grahamJobs_nonneg m) hσ - rw [grahamJobs_lpt_makespan_internal m σ hσ, hτ, grahamJobs_optMakespan_internal m] at h + rw [grahamJobs_lpt_makespan m σ hσ, hτ, grahamJobs_optMakespan m] at h rw [hc, div_le_iff₀ hm3] linarith diff --git a/LeanPool/GrahamLPT/TightLPT.lean b/LeanPool/GrahamLPT/TightLPT.lean index e47327d300..65ab57711f 100644 --- a/LeanPool/GrahamLPT/TightLPT.lean +++ b/LeanPool/GrahamLPT/TightLPT.lean @@ -19,8 +19,6 @@ import Mathlib.Tactic.Positivity.Finset # TightLPT Graham's family: optimum `3m`, LPT makespan `4m − 1`. -Helpers carry the prefix `tg_`; the `_internal` twins of the Challenge theorems are closed in -`Contracts.lean`. -/ @[expose] public section @@ -143,7 +141,7 @@ theorem tg_exists_opt (m : ℕ) [NeZero m] : theorem tg_le_makespan (m : ℕ) [NeZero m] (τ : Fin (2 * m + 1) → Fin m) : 3 * (m : ℝ) ≤ makespan (grahamJobs m) τ := by have hm : (0 : ℝ) < m := by exact_mod_cast NeZero.pos m - have h := sum_le_mul_makespan_internal (grahamJobs m) τ + have h := sum_le_mul_makespan (grahamJobs m) τ rw [tg_grahamJobs_sum] at h have h' : (m : ℝ) * (3 * m) ≤ (m : ℝ) * makespan (grahamJobs m) τ := by linarith exact le_of_mul_le_mul_left h' hm @@ -169,7 +167,7 @@ theorem tg_exists_prefix_pairing (m : ℕ) [NeZero m] : exact tg_pair m ⟨i, by omega⟩ (by dsimp only; omega) /-- Graham's instance is listed in nonincreasing order. -/ -theorem grahamJobs_antitone_internal (m : ℕ) : Antitone (grahamJobs m) := by +theorem grahamJobs_antitone (m : ℕ) : Antitone (grahamJobs m) := by intro a b hab have hab' : (a : ℕ) ≤ b := hab by_cases hb : (b : ℕ) < 2 * m @@ -196,7 +194,7 @@ theorem tg_loadBefore_two_mul (m : ℕ) [NeZero m] (σ : Fin (2 * m + 1) → Fin by_cases hex : ∃ j : Fin (2 * m + 1), (j : ℕ) < 2 * m ∧ σ j = i' · obtain ⟨k, hk, hσk, heq⟩ := bs_exists_last_job_before (grahamJobs m) σ (2 * m) i' hex rw [heq, ← hσk] - apply key_lemma (grahamJobs m) hp (grahamJobs_antitone_internal m) σ hσ k τ (3 * m - 1) + apply key_lemma (grahamJobs m) hp (grahamJobs_antitone m) σ hσ k τ (3 * m - 1) · intro i'' rw [← hτ i''] exact bs_loadBefore_mono _ hp τ (by omega) i'' @@ -229,8 +227,8 @@ theorem tg_listSchedule_makespan (m : ℕ) [NeZero m] (σ : Fin (2 * m + 1) → have hmR : (0 : ℝ) < m := by exact_mod_cast hm apply le_antisymm · obtain ⟨τ, hτ⟩ := tg_exists_opt m - have h1 := lpt_bound_internal (grahamJobs m) (tg_grahamJobs_nonneg m) σ - ⟨1, by simpa using grahamJobs_antitone_internal m, by simpa using hσ⟩ τ + have h1 := lpt_bound (grahamJobs m) (tg_grahamJobs_nonneg m) σ + ⟨1, by simpa using grahamJobs_antitone m, by simpa using hσ⟩ τ have h2 : makespan (grahamJobs m) τ = 3 * m := le_antisymm ((bs_makespan_le_iff _ _ _).2 (fun i => (hτ i).le)) (tg_le_makespan m τ) rw [h2] at h1 @@ -244,7 +242,7 @@ theorem tg_listSchedule_makespan (m : ℕ) [NeZero m] (σ : Fin (2 * m + 1) → rw [ite_eq_left rfl] at this exact this have h3 := bs_loadBefore_of_le (grahamJobs m) σ (2 * m + 1) le_rfl (σ ⟨2 * m, by omega⟩) - have h4 := load_le_makespan_internal (grahamJobs m) σ (σ ⟨2 * m, by omega⟩) + have h4 := load_le_makespan (grahamJobs m) σ (σ ⟨2 * m, by omega⟩) have h5 := tg_grahamJobs_apply_last m ⟨2 * m, by omega⟩ (by dsimp only; omega) linarith @@ -253,29 +251,29 @@ theorem tg_listSchedule_makespan (m : ℕ) [NeZero m] (σ : Fin (2 * m + 1) → theorem tg_comp_eq (m : ℕ) (π : Equiv.Perm (Fin (2 * m + 1))) (h : Antitone (grahamJobs m ∘ π)) : grahamJobs m ∘ π = grahamJobs m := by have h1 : Antitone (grahamJobs m ∘ ⇑(1 : Equiv.Perm (Fin (2 * m + 1)))) := by - simpa using grahamJobs_antitone_internal m + simpa using grahamJobs_antitone m have h2 := Tuple.unique_antitone h h1 simpa using h2 /-- Graham's instance has optimal makespan `3m`. -/ -theorem grahamJobs_optMakespan_internal (m : ℕ) [NeZero m] : optMakespan m (grahamJobs m) = 3 * m +theorem grahamJobs_optMakespan (m : ℕ) [NeZero m] : optMakespan m (grahamJobs m) = 3 * m := by obtain ⟨τ, hτ⟩ := tg_exists_opt m apply le_antisymm - · calc optMakespan m (grahamJobs m) ≤ makespan (grahamJobs m) τ := optMakespan_le_internal _ τ + · calc optMakespan m (grahamJobs m) ≤ makespan (grahamJobs m) τ := optMakespan_le _ τ _ ≤ 3 * m := (bs_makespan_le_iff _ _ _).2 (fun i => (hτ i).le) - · obtain ⟨τ', hτ'⟩ := exists_makespan_eq_optMakespan_internal (m := m) (grahamJobs m) + · obtain ⟨τ', hτ'⟩ := exists_makespan_eq_optMakespan (m := m) (grahamJobs m) rw [← hτ'] exact tg_le_makespan m τ' /-- Every LPT schedule of Graham's instance has makespan `4m − 1`: the bound `4/3 − 1/(3m)` is attained for every `m`. -/ -theorem grahamJobs_lpt_makespan_internal (m : ℕ) [NeZero m] (σ : Fin (2 * m + 1) → Fin m) +theorem grahamJobs_lpt_makespan (m : ℕ) [NeZero m] (σ : Fin (2 * m + 1) → Fin m) (hσ : IsLPTSchedule (grahamJobs m) σ) : makespan (grahamJobs m) σ = 4 * m - 1 := by obtain ⟨π, hanti, hls⟩ := hσ have hc := tg_comp_eq m π hanti rw [hc] at hls have h1 := tg_listSchedule_makespan m (σ ∘ π) hls - rw [← makespan_comp_internal (grahamJobs m) σ π, hc, h1] + rw [← makespan_comp (grahamJobs m) σ π, hc, h1] end GrahamLPT diff --git a/LeanPool/GrahamLPT/TightList.lean b/LeanPool/GrahamLPT/TightList.lean index 02e4d15d74..384342878a 100644 --- a/LeanPool/GrahamLPT/TightList.lean +++ b/LeanPool/GrahamLPT/TightList.lean @@ -17,8 +17,6 @@ import Mathlib.Tactic.Positivity.Finset # TightList The unit-job family: optimum `m`, list-schedule makespan `2m − 1`. -Helpers carry the prefix `tl_`; the `_internal` twins of the Challenge theorems are closed in -`Contracts.lean`. -/ @[expose] public section @@ -122,7 +120,7 @@ theorem tl_loadBefore_units (m : ℕ) [NeZero m] (σ : Fin (m * (m - 1) + 1) → theorem tl_le_makespan (m : ℕ) [NeZero m] (τ : Fin (m * (m - 1) + 1) → Fin m) : (m : ℝ) ≤ makespan (unitJobs m) τ := by - have h := le_makespan_of_nonneg_internal (unitJobs m) (tl_unitJobs_nonneg m) τ (Fin.last _) + have h := le_makespan_of_nonneg (unitJobs m) (tl_unitJobs_nonneg m) τ (Fin.last _) rwa [tl_unitJobs_apply_last m _ (by simp)] at h /-- An assignment of makespan `m`: the unit jobs spread `m` per machine over `m − 1` machines, the @@ -193,23 +191,23 @@ theorem tl_exists_makespan_eq (m : ℕ) [NeZero m] : exact_mod_cast hcard /-- The `m(m − 1)` unit jobs with one job of length `m` have optimal makespan `m`. -/ -theorem unitJobs_optMakespan_internal (m : ℕ) [NeZero m] : optMakespan m (unitJobs m) = m := by +theorem unitJobs_optMakespan (m : ℕ) [NeZero m] : optMakespan m (unitJobs m) = m := by apply le_antisymm · obtain ⟨τ, hτ⟩ := tl_exists_makespan_eq m rw [← hτ] - exact optMakespan_le_internal _ τ - · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan_internal (m := m) (unitJobs m) + exact optMakespan_le _ τ + · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) (unitJobs m) rw [← hτ] exact tl_le_makespan m τ /-- Every list schedule of the unit jobs followed by the job of length `m` has makespan `2m − 1`. -/ -theorem unitJobs_listSchedule_makespan_internal (m : ℕ) [NeZero m] (σ : Fin (m * (m - 1) + 1) → +theorem unitJobs_listSchedule_makespan (m : ℕ) [NeZero m] (σ : Fin (m * (m - 1) + 1) → Fin m) (hσ : IsListSchedule (unitJobs m) σ) : makespan (unitJobs m) σ = 2 * m - 1 := by have hm : (1 : ℝ) ≤ m := by exact_mod_cast (NeZero.one_le : 1 ≤ m) obtain ⟨τ, hτ⟩ := tl_exists_makespan_eq m apply le_antisymm - · have h := listSchedule_bound_internal (unitJobs m) (tl_unitJobs_nonneg m) σ hσ τ + · have h := listSchedule_bound (unitJobs m) (tl_unitJobs_nonneg m) σ hσ τ rw [hτ] at h exact le_of_mul_le_mul_left (a := (m : ℝ)) (by linarith) (by linarith) · have h1 := bs_loadBefore_succ (unitJobs m) σ (Fin.last _) (σ (Fin.last _)) @@ -217,7 +215,7 @@ theorem unitJobs_listSchedule_makespan_internal (m : ℕ) [NeZero m] (σ : Fin ( simp only [Fin.val_last] at h1 rw [bs_loadBefore_of_le (unitJobs m) σ (m * (m - 1) + 1) le_rfl, tl_loadBefore_units m σ hσ] at h1 - have h2 := load_le_makespan_internal (unitJobs m) σ (σ (Fin.last _)) + have h2 := load_le_makespan (unitJobs m) σ (σ (Fin.last _)) linarith end GrahamLPT From 8f733d0cf7694d9f1ffd2da511bd329c2a0e87f3 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 20 Oct 2026 11:15:41 +0000 Subject: [PATCH 3/5] Consolidate remaining scheduling theorem aliases after review --- LeanPool/GrahamLPT/Basic.lean | 34 ++++++++-------------------- LeanPool/GrahamLPT/CoffmanSethi.lean | 17 ++++---------- LeanPool/GrahamLPT/Counter.lean | 32 ++++++++------------------ LeanPool/GrahamLPT/GrahamScaled.lean | 4 ++-- LeanPool/GrahamLPT/ListOptimum.lean | 20 ++++------------ 5 files changed, 29 insertions(+), 78 deletions(-) diff --git a/LeanPool/GrahamLPT/Basic.lean b/LeanPool/GrahamLPT/Basic.lean index 8092c810e6..8c4e377266 100644 --- a/LeanPool/GrahamLPT/Basic.lean +++ b/LeanPool/GrahamLPT/Basic.lean @@ -207,15 +207,15 @@ theorem bs_exists_load_eq_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) ( obtain ⟨i, -, h⟩ := Finset.exists_mem_eq_sup' (univ_nonempty (α := Fin m)) (load p σ) exact ⟨i, h.symm⟩ -/-- Every machine load is at most the makespan (the helper behind the twin). -/ -theorem bs_load_le_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : Fin m) : +/-- Every machine load is at most the makespan. -/ +theorem load_le_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : Fin m) : load p σ i ≤ makespan p σ := Finset.le_sup' (load p σ) (mem_univ i) theorem bs_makespan_nonneg {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : Fin n → Fin m) : 0 ≤ makespan p σ := - le_trans (Finset.sum_nonneg fun j _ => hp j) (bs_load_le_makespan p σ 0) + le_trans (Finset.sum_nonneg fun j _ => hp j) (load_le_makespan p σ 0) /-- Relabeling the jobs by a permutation changes no load. -/ theorem bs_load_comp {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (π : Equiv.Perm (Fin n)) (i : @@ -225,16 +225,16 @@ theorem bs_load_comp {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (π rw [Finset.sum_filter, Finset.sum_filter] exact Equiv.sum_comp π (fun j => if σ j = i then p j else 0) -/-- The total length is at most `m` times the makespan (the helper behind the twin). -/ -theorem bs_sum_le_mul_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) : +/-- The total length is at most `m` times the makespan. -/ +theorem sum_le_mul_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) : ∑ j, p j ≤ (m : ℝ) * makespan p σ := by rw [← bs_sum_load p σ] have h : ∑ i, load p σ i ≤ ∑ _i : Fin m, makespan p σ := - Finset.sum_le_sum fun i _ => bs_load_le_makespan p σ i + Finset.sum_le_sum fun i _ => load_le_makespan p σ i simpa [Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul] using h -/-- The optimal makespan is attained (the helper behind the twin). -/ -theorem bs_exists_makespan_eq_opt {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : +/-- The optimal makespan is attained. -/ +theorem exists_makespan_eq_optMakespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : ∃ τ : Fin n → Fin m, makespan p τ = optMakespan m p := by obtain ⟨τ, -, h⟩ := Finset.exists_mem_eq_inf' (univ_nonempty (α := Fin n → Fin m)) (fun σ : Fin n → Fin m => makespan p σ) @@ -307,29 +307,13 @@ theorem optMakespan_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (τ : Fin n optMakespan m p ≤ makespan p τ := Finset.inf'_le (fun σ : Fin n → Fin m => makespan p σ) (mem_univ τ) -/-- The optimal makespan is attained. -/ -theorem exists_makespan_eq_optMakespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) : - ∃ τ : Fin n → Fin m, makespan p τ = optMakespan m p := - bs_exists_makespan_eq_opt p - -/-- Every machine load is at most the makespan. -/ -theorem load_le_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : - Fin m) : - load p σ i ≤ makespan p σ := - bs_load_le_makespan p σ i - /-- For nonnegative lengths every job is at most the makespan. -/ theorem le_makespan_of_nonneg {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (σ : Fin n → Fin m) (j : Fin n) : p j ≤ makespan p σ := by - refine le_trans ?_ (bs_load_le_makespan p σ (σ j)) + refine le_trans ?_ (load_le_makespan p σ (σ j)) exact Finset.single_le_sum (fun j _ => hp j) (by simp : j ∈ univ.filter (fun j' : Fin n => σ j' = σ j)) -/-- The total length is at most `m` times the makespan. -/ -theorem sum_le_mul_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) : - ∑ j, p j ≤ (m : ℝ) * makespan p σ := - bs_sum_le_mul_makespan p σ - /-- Relabeling the jobs by a permutation does not change the makespan. -/ theorem makespan_comp {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (σ : Fin n → Fin m) (π : Equiv.Perm (Fin n)) : diff --git a/LeanPool/GrahamLPT/CoffmanSethi.lean b/LeanPool/GrahamLPT/CoffmanSethi.lean index 2e7af627d6..01d694f17e 100644 --- a/LeanPool/GrahamLPT/CoffmanSethi.lean +++ b/LeanPool/GrahamLPT/CoffmanSethi.lean @@ -6,7 +6,6 @@ Authors: JD Jones module - import Mathlib.Algebra.BigOperators.Field public import LeanPool.GrahamLPT.Defs public import Mathlib.Algebra.Order.Archimedean.Real.Basic @@ -261,7 +260,8 @@ theorem cs_cnt_le_fl_of_min {m n : ℕ} (p : Fin n → ℝ) (hanti : Antitone p) /-- Chen's property, sorted form: job `k` is the `(c + 1)`-th job on its machine, `c` the jobs of smaller index there; then `(c + 1) · p_k ≤ C(τ)` for every assignment `τ`. -/ -theorem cs_job_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (hanti : Antitone p) +theorem lpt_job_position_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) + (hanti : Antitone p) (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (τ : Fin n → Fin m) : (((univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = σ k)).card : ℝ) + 1) * p k ≤ makespan p τ := by @@ -310,7 +310,7 @@ theorem cs_job_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ unfold loadBefore rw [sum_div] exact sum_le_sum fun j _ => Int.floor_le _ - have h2 := (bs_loadBefore_le_load p hp τ ((k : ℕ) + 1) g).trans (bs_load_le_makespan p τ g) + have h2 := (bs_loadBefore_le_load p hp τ ((k : ℕ) + 1) g).trans (load_le_makespan p τ g) have h3 : loadBefore p τ ((k : ℕ) + 1) g / p k < (c : ℝ) + 1 := by rw [div_lt_iff₀ hpos] linarith @@ -378,11 +378,11 @@ theorem cs_bound {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p unfold load loadBefore rw [eF, sum_insert hknot] ring - have hchen := cs_job_le p hp hanti σ hσ k τ + have hchen := lpt_job_position_le p hp hanti σ hσ k τ rw [← hcard] at hchen have h1 := bs_mul_loadBefore_le p σ hσ k have h2 := bs_sum_filter_add_le p hp k - have h3 := bs_sum_le_mul_makespan p τ + have h3 := sum_le_mul_makespan p τ have hmC : (m : ℝ) * makespan p σ ≤ m * makespan p τ + (m - 1) * p k := by rw [hload] linarith @@ -412,11 +412,4 @@ theorem lpt_bound_of_card {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j Finset.card_equiv π (fun j => by simp) rwa [hcard, makespan_comp, makespan_comp] at h -theorem lpt_job_position_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) - (hanti : Antitone p) - (σ : Fin n → Fin m) (hσ : IsListSchedule p σ) (k : Fin n) (τ : Fin n → Fin m) : - (((univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = σ k)).card : ℝ) + 1) * p k ≤ makespan p τ - := - cs_job_le p hp hanti σ hσ k τ - end GrahamLPT diff --git a/LeanPool/GrahamLPT/Counter.lean b/LeanPool/GrahamLPT/Counter.lean index c64d2f8479..3c0e4607fd 100644 --- a/LeanPool/GrahamLPT/Counter.lean +++ b/LeanPool/GrahamLPT/Counter.lean @@ -69,7 +69,7 @@ theorem cx_antitone : Antitone (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) := by /-- The assignment `0, 1, 2, 1, 2, 0` of the jobs `9, 5, 5, 4, 4, 4` to `3` machines is an LPT schedule (the identity order) and has makespan `13`. -/ -theorem cx_lpt_thirteen : +theorem nine_five_four_lpt_thirteen : IsLPTSchedule (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) (![0, 1, 2, 1, 2, 0] : Fin 6 → Fin 3) ∧ makespan (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) (![0, 1, 2, 1, 2, 0] : Fin 6 → Fin 3) = 13 := by refine ⟨⟨1, ?_, ?_⟩, ?_⟩ @@ -81,7 +81,7 @@ theorem cx_lpt_thirteen : · rw [bs_makespan_le_iff] intro i fin_cases i <;> norm_num [load, Finset.sum_filter, Fin.sum_univ_six] - · refine le_trans (le_of_eq ?_) (bs_load_le_makespan _ _ 0) + · refine le_trans (le_of_eq ?_) (load_le_makespan _ _ 0) norm_num [load, Finset.sum_filter, Fin.sum_univ_six] /-- Every assignment of the jobs `9, 5, 5, 4, 4, 4` to `3` machines has a machine of load at least @@ -97,7 +97,7 @@ theorem cx_twelve_le_makespan (τ : Fin 6 → Fin 3) : by intro i S hS h12 have h1 := cx_sum_le_load p hp τ i S hS - have h2 := bs_load_le_makespan p τ i + have h2 := load_le_makespan p τ i linarith -- job `0` (length `9`) shares its machine with no other job by_cases h1 : τ 1 = τ 0 @@ -161,13 +161,13 @@ theorem cx_twelve_le_makespan (τ : Fin 6 → Fin 3) : /-- The jobs `9, 5, 5, 4, 4, 4` have optimal makespan `12` on `3` machines, attained by `0, 1, 1, 2, 2, 2`. -/ -theorem cx_opt_twelve : optMakespan 3 (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) = 12 := by +theorem nine_five_four_optMakespan : optMakespan 3 (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) = 12 := by apply le_antisymm · refine le_trans (optMakespan_le _ (![0, 1, 1, 2, 2, 2] : Fin 6 → Fin 3)) ?_ rw [bs_makespan_le_iff] intro i fin_cases i <;> norm_num [load, Finset.sum_filter, Fin.sum_univ_six] - · obtain ⟨τ, hτ⟩ := bs_exists_makespan_eq_opt (m := 3) (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) + · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := 3) (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) rw [← hτ] exact cx_twelve_le_makespan τ @@ -176,29 +176,15 @@ jobs do not make LPT optimal: on `3` machines the six jobs `9, 5, 5, 4, 4, 4` are each at least a third of the optimal makespan `12`, yet an LPT schedule of them has makespan `13`. -/ -theorem cx_third_le_not_optimal : +theorem lpt_third_le_not_optimal : ∃ (p : Fin 6 → ℝ) (σ : Fin 6 → Fin 3), (∀ j, 0 ≤ p j) ∧ IsLPTSchedule p σ ∧ (∀ j, optMakespan 3 p ≤ 3 * p j) ∧ optMakespan 3 p < makespan p σ := by - refine ⟨![9, 5, 5, 4, 4, 4], ![0, 1, 2, 1, 2, 0], ?_, cx_lpt_thirteen.1, ?_, ?_⟩ + refine ⟨![9, 5, 5, 4, 4, 4], ![0, 1, 2, 1, 2, 0], ?_, nine_five_four_lpt_thirteen.1, ?_, ?_⟩ · intro j; fin_cases j <;> norm_num · intro j - rw [cx_opt_twelve] + rw [nine_five_four_optMakespan] fin_cases j <;> norm_num - · rw [cx_opt_twelve, cx_lpt_thirteen.2] + · rw [nine_five_four_optMakespan, nine_five_four_lpt_thirteen.2] norm_num -theorem nine_five_four_lpt_thirteen : - IsLPTSchedule (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) (![0, 1, 2, 1, 2, 0] : Fin 6 → Fin 3) ∧ - makespan (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) (![0, 1, 2, 1, 2, 0] : Fin 6 → Fin 3) = 13 := - cx_lpt_thirteen - -theorem nine_five_four_optMakespan : optMakespan 3 (![9, 5, 5, 4, 4, 4] : Fin 6 → ℝ) = 12 - := - cx_opt_twelve - -theorem lpt_third_le_not_optimal : - ∃ (p : Fin 6 → ℝ) (σ : Fin 6 → Fin 3), (∀ j, 0 ≤ p j) ∧ IsLPTSchedule p σ ∧ - (∀ j, optMakespan 3 p ≤ 3 * p j) ∧ optMakespan 3 p < makespan p σ := - cx_third_le_not_optimal - end GrahamLPT diff --git a/LeanPool/GrahamLPT/GrahamScaled.lean b/LeanPool/GrahamLPT/GrahamScaled.lean index 858aac1cc2..3e43af6b06 100644 --- a/LeanPool/GrahamLPT/GrahamScaled.lean +++ b/LeanPool/GrahamLPT/GrahamScaled.lean @@ -47,10 +47,10 @@ theorem gs_makespan_smul {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (a : ℝ) (h · rw [bs_makespan_le_iff] intro i rw [gs_load_smul] - exact mul_le_mul_of_nonneg_left (bs_load_le_makespan p σ i) ha + exact mul_le_mul_of_nonneg_left (load_le_makespan p σ i) ha · obtain ⟨i, hi⟩ := bs_exists_load_eq_makespan p σ rw [← hi, ← gs_load_smul p a σ i] - exact bs_load_le_makespan _ σ i + exact load_le_makespan _ σ i /-- Scaling the lengths by `a ≥ 0` scales the optimal makespan. -/ theorem gs_optMakespan_smul {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (a : ℝ) (ha : 0 ≤ a) : diff --git a/LeanPool/GrahamLPT/ListOptimum.lean b/LeanPool/GrahamLPT/ListOptimum.lean index b938b279bb..5df18cae90 100644 --- a/LeanPool/GrahamLPT/ListOptimum.lean +++ b/LeanPool/GrahamLPT/ListOptimum.lean @@ -157,7 +157,7 @@ theorem lo_makespan_le {m n : ℕ} [NeZero m] (q : Fin n → ℝ) (hq : ∀ j, 0 by a list schedule in some order (the jobs listed by their start times when each machine of `τ` runs its jobs in index order). -/ -theorem lo_exists_listSchedule_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) +theorem exists_listSchedule_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (τ : Fin n → Fin m) : ∃ (π : Equiv.Perm (Fin n)) (σ : Fin n → Fin m), IsListSchedule (p ∘ π) (σ ∘ π) ∧ makespan p σ ≤ makespan p τ := by @@ -183,7 +183,7 @@ theorem lo_exists_listSchedule_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp have hC : ∀ j, s j + p j ≤ makespan p τ := by intro j rw [hsucc j] - exact (bs_loadBefore_le_load p hp τ _ _).trans (bs_load_le_makespan p τ _) + exact (bs_loadBefore_le_load p hp τ _ _).trans (load_le_makespan p τ _) set π := Tuple.sort s with hπ have hmono : Monotone (s ∘ π) := Tuple.monotone_sort s obtain ⟨σ', hσ'⟩ := exists_isListSchedule (m := m) (p ∘ π) @@ -201,28 +201,16 @@ theorem lo_exists_listSchedule_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp /-- The optimal makespan is the least makespan over the list schedules in all orders (Graham's `ω₀` equals `optMakespan`). -/ -theorem lo_optMakespan_eq {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) : +theorem isLeast_listSchedule_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) : IsLeast ((fun σ : Fin n → Fin m => makespan p σ) '' {σ | ∃ π : Equiv.Perm (Fin n), IsListSchedule (p ∘ π) (σ ∘ π)}) (optMakespan m p) := by constructor · obtain ⟨τ, hτ⟩ := exists_makespan_eq_optMakespan (m := m) p - obtain ⟨π, σ, hσ, hle⟩ := lo_exists_listSchedule_le p hp τ + obtain ⟨π, σ, hσ, hle⟩ := exists_listSchedule_le p hp τ refine ⟨σ, ⟨π, hσ⟩, le_antisymm ?_ (optMakespan_le p σ)⟩ rw [← hτ] exact hle · rintro c ⟨σ, -, rfl⟩ exact optMakespan_le p σ -theorem exists_listSchedule_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) - (τ : Fin n → Fin m) : - ∃ (π : Equiv.Perm (Fin n)) (σ : Fin n → Fin m), - IsListSchedule (p ∘ π) (σ ∘ π) ∧ makespan p σ ≤ makespan p τ := - lo_exists_listSchedule_le p hp τ - -theorem isLeast_listSchedule_makespan {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ - p j) : - IsLeast ((fun σ : Fin n → Fin m => makespan p σ) '' - {σ | ∃ π : Equiv.Perm (Fin n), IsListSchedule (p ∘ π) (σ ∘ π)}) (optMakespan m p) := - lo_optMakespan_eq p hp - end GrahamLPT From ad9d5db168ec7a59aea3f8d07065068b03aa2ce5 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 20 Oct 2026 11:54:20 +0000 Subject: [PATCH 4/5] Reuse optimal schedules and tail bounds for padded instances --- LeanPool/GrahamLPT/Basic.lean | 20 +++++ LeanPool/GrahamLPT/FixedCount.lean | 130 ++++++++--------------------- 2 files changed, 54 insertions(+), 96 deletions(-) diff --git a/LeanPool/GrahamLPT/Basic.lean b/LeanPool/GrahamLPT/Basic.lean index 8c4e377266..ececd15be7 100644 --- a/LeanPool/GrahamLPT/Basic.lean +++ b/LeanPool/GrahamLPT/Basic.lean @@ -62,6 +62,26 @@ theorem bs_loadBefore_of_le {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin have := j.isLt exact ⟨fun h => h.2, fun h => ⟨by omega, h⟩⟩ +/-- If every later job has length at most `ε ≥ 0`, a full load exceeds its prefix by at most +`nε`. -/ +theorem load_le_loadBefore_add {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) + (k : ℕ) (ε : ℝ) (hε : 0 ≤ ε) (htail : ∀ j : Fin n, k ≤ (j : ℕ) → p j ≤ ε) + (i : Fin m) : load p σ i ≤ loadBefore p σ k i + n * ε := by + calc + load p σ i = ∑ j : Fin n, if σ j = i then p j else 0 := by rw [load, sum_filter] + _ ≤ ∑ j : Fin n, ((if (j : ℕ) < k ∧ σ j = i then p j else 0) + ε) := by + refine sum_le_sum fun j _ => ?_ + by_cases hji : σ j = i + · by_cases hj : (j : ℕ) < k + · simpa only [hji, hj, and_self, ↓reduceIte] using + (le_add_of_nonneg_right hε : p j ≤ p j + ε) + · simpa only [hji, hj, false_and, ↓reduceIte, zero_add] using + htail j (Nat.le_of_not_gt hj) + · simpa only [hji, and_false, ↓reduceIte, zero_add] using hε + _ = loadBefore p σ k i + n * ε := by + simp only [sum_add_distrib, sum_const, card_univ, Fintype.card_fin, + nsmul_eq_mul, loadBefore, sum_filter] + /-- Restricting a job vector and assignment preserves every load in the retained prefix. -/ theorem loadBefore_restrict {m n N : ℕ} (h : n ≤ N) (p : Fin N → ℝ) (σ : Fin N → Fin m) (k : ℕ) (hk : k ≤ n) (i : Fin m) : diff --git a/LeanPool/GrahamLPT/FixedCount.lean b/LeanPool/GrahamLPT/FixedCount.lean index 5403dfed23..4897a9fa4c 100644 --- a/LeanPool/GrahamLPT/FixedCount.lean +++ b/LeanPool/GrahamLPT/FixedCount.lean @@ -36,6 +36,20 @@ noncomputable def paddedJobLength (m : ℕ) (ε : ℝ) (j : ℕ) : ℝ := /-- Graham's `2m + 1` jobs followed by `n − 2m − 1` jobs of length `ε`. -/ noncomputable def paddedJobs (m n : ℕ) (ε : ℝ) : Fin n → ℝ := fun j => paddedJobLength m ε j +/-- The unpadded jobs agree with Graham's original instance. -/ +theorem paddedJobLength_eq_grahamJobs (m : ℕ) (ε : ℝ) (j : Fin (2 * m + 1)) : + paddedJobLength m ε j = grahamJobs m j := by + by_cases h : (j : ℕ) < 2 * m + · simp only [paddedJobLength, grahamJobs, h, ite_true] + · have hj : (j : ℕ) = 2 * m := by omega + simp only [paddedJobLength, grahamJobs, hj, ite_true] + +/-- Restriction to the original job count removes the small-job tail. -/ +theorem paddedJobs_restrict (m n : ℕ) (ε : ℝ) (hn : 2 * m + 1 ≤ n) : + paddedJobs m n ε ∘ Fin.castLE hn = grahamJobs m := by + funext j + exact paddedJobLength_eq_grahamJobs m ε j + theorem fc_len_lt (m : ℕ) (ε : ℝ) (j : ℕ) (h : j < 2 * m) : paddedJobLength m ε j = 2 * (m : ℝ) - 1 - ((j / 2 : ℕ) : ℝ) := by unfold paddedJobLength @@ -53,14 +67,8 @@ theorem fc_len_gt (m : ℕ) (ε : ℝ) (j : ℕ) (h : 2 * m < j) : paddedJobLeng /-- Each of Graham's jobs is at least `m`. -/ theorem fc_le_len (m : ℕ) (ε : ℝ) (j : ℕ) (h : j ≤ 2 * m) : (m : ℝ) ≤ paddedJobLength m ε j := by - rcases Nat.lt_or_ge j (2 * m) with h1 | h1 - · rw [fc_len_lt m ε j h1] - have h2 : j / 2 + 1 ≤ m := by omega - have h3 : ((j / 2 : ℕ) : ℝ) + 1 ≤ (m : ℝ) := by exact_mod_cast h2 - linarith - · have h2 : j = 2 * m := by omega - rw [h2] - exact (fc_len_two_mul m ε).ge + rw [paddedJobLength_eq_grahamJobs m ε ⟨j, by omega⟩] + exact tg_le_grahamJobs m _ theorem fc_len_pos (m : ℕ) (ε : ℝ) (hm : 0 < m) (hε : 0 < ε) (j : ℕ) : 0 < paddedJobLength m ε j := by @@ -95,20 +103,6 @@ theorem fc_antitone (m n : ℕ) (ε : ℝ) (hε : ε ≤ m) : Antitone (paddedJo exact h1 · simp only [fc_len_gt m ε a (by omega), fc_len_gt m ε b (by omega), le_refl] -/-- The unpadded jobs agree with Graham's original instance. -/ -theorem paddedJobLength_eq_grahamJobs (m : ℕ) (ε : ℝ) (j : Fin (2 * m + 1)) : - paddedJobLength m ε j = grahamJobs m j := by - by_cases h : (j : ℕ) < 2 * m - · simp only [paddedJobLength, grahamJobs, h, ite_true] - · have hj : (j : ℕ) = 2 * m := by omega - simp only [paddedJobLength, grahamJobs, hj, ite_true] - -/-- Restriction to the original job count removes the small-job tail. -/ -theorem paddedJobs_restrict (m n : ℕ) (ε : ℝ) (hn : 2 * m + 1 ≤ n) : - paddedJobs m n ε ∘ Fin.castLE hn = grahamJobs m := by - funext j - exact paddedJobLength_eq_grahamJobs m ε j - /-- The pairs `j, 2m − 1 − j` among the original jobs sum to `3m − 1`. -/ theorem fc_pair (m : ℕ) (ε : ℝ) (j : ℕ) (h : j < 2 * m) : paddedJobLength m ε j + paddedJobLength m ε (2 * m - 1 - j) = 3 * m - 1 := by @@ -210,82 +204,26 @@ theorem fc_le_makespan_lpt (m n : ℕ) [NeZero m] (ε : ℝ) (hε0 : 0 < ε) (h rw [← makespan_comp (paddedJobs m n ε) σ π, hc] exact h1 -/-- The pairing `j ↦ min (j, 2m − 3 − j)` of the first `2m − 2` jobs, the three jobs of length `m` -and every -small job on the last machine: every load is at most `3m + nε`. -/ +/-- Extend an optimal assignment of the original jobs by assigning the small-job tail to +machine zero; each load is at most `3m + nε`. -/ theorem fc_exists_opt (m n : ℕ) [NeZero m] (ε : ℝ) (hε0 : 0 ≤ ε) (hn : 2 * m + 1 ≤ n) : ∃ τ : Fin n → Fin m, ∀ i, load (paddedJobs m n ε) τ i ≤ 3 * m + n * ε := by - have hm : 0 < m := NeZero.pos m - refine ⟨fun j => if h : (j : ℕ) < 2 * m - 2 then ⟨min (j : ℕ) (2 * m - 3 - j), by omega⟩ - else ⟨m - 1, by omega⟩, fun i => ?_⟩ - have hi := i.isLt - have hnε : 0 ≤ (n : ℝ) * ε := mul_nonneg (Nat.cast_nonneg n) hε0 - unfold load - by_cases hlt : (i : ℕ) < m - 1 - · have hfib : univ.filter (fun j : Fin n => - (if h : (j : ℕ) < 2 * m - 2 then (⟨min (j : ℕ) (2 * m - 3 - j), by omega⟩ : Fin m) - else ⟨m - 1, by omega⟩) = i) = - {(⟨i, by omega⟩ : Fin n), ⟨2 * m - 3 - i, by omega⟩} := by - ext j - have hj := j.isLt - simp only [mem_filter, mem_univ, true_and, mem_insert, mem_singleton, Fin.ext_iff] - split_ifs with h1 <;> dsimp only <;> omega - rw [hfib, sum_pair (by rw [Ne, Fin.ext_iff]; dsimp only; omega)] - have := fc_pair' m ε i (by omega) - change paddedJobLength m ε i + paddedJobLength m ε (2 * m - 3 - i) ≤ 3 * m + n * ε - linarith only [this, hnε] - · have hfib : univ.filter (fun j : Fin n => - (if h : (j : ℕ) < 2 * m - 2 then (⟨min (j : ℕ) (2 * m - 3 - j), by omega⟩ : Fin m) - else ⟨m - 1, by omega⟩) = i) = - univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ)) := by - ext j - have hj := j.isLt - simp only [mem_filter, mem_univ, true_and, Fin.ext_iff] - split_ifs with h1 <;> dsimp only <;> omega - rw [hfib, ← sum_filter_add_sum_filter_not (univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ))) - (fun j : Fin n => (j : ℕ) < 2 * m + 1)] - have hA : (univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ))).filter - (fun j : Fin n => (j : ℕ) < 2 * m + 1) = - {(⟨2 * m - 2, by omega⟩ : Fin n), ⟨2 * m - 1, by omega⟩, ⟨2 * m, by omega⟩} := by - ext j - have hj := j.isLt - simp only [mem_filter, mem_univ, true_and, mem_insert, mem_singleton, Fin.ext_iff] - omega - have hB : ∑ j ∈ (univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ))).filter - (fun j : Fin n => ¬ (j : ℕ) < 2 * m + 1), paddedJobs m n ε j ≤ n * ε := by - calc ∑ j ∈ (univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ))).filter - (fun j : Fin n => ¬ (j : ℕ) < 2 * m + 1), paddedJobs m n ε j - = ∑ _j ∈ (univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ))).filter - (fun j : Fin n => ¬ (j : ℕ) < 2 * m + 1), ε := by - refine sum_congr rfl fun j hj => ?_ - simp only [mem_filter, mem_univ, true_and] at hj - exact fc_len_gt m ε j (by omega) - _ = (((univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ))).filter - (fun j : Fin n => ¬ (j : ℕ) < 2 * m + 1)).card : ℝ) * ε := by - rw [sum_const, nsmul_eq_mul] - _ ≤ n * ε := by - apply mul_le_mul_of_nonneg_right _ hε0 - have := card_le_univ ((univ.filter (fun j : Fin n => 2 * m - 2 ≤ (j : ℕ))).filter - (fun j : Fin n => ¬ (j : ℕ) < 2 * m + 1)) - rw [Fintype.card_fin] at this - exact_mod_cast this - rw [hA, sum_insert (by simp only [mem_insert, mem_singleton, Fin.ext_iff]; omega), - sum_pair (by rw [Ne, Fin.ext_iff]; dsimp only; omega)] - have e1 : paddedJobs m n ε ⟨2 * m - 2, by omega⟩ = m := by - change paddedJobLength m ε (2 * m - 2) = m - rw [fc_len_lt m ε (2 * m - 2) (by omega)] - have h : (2 * m - 2) / 2 + 1 = m := by omega - have h' : (((2 * m - 2) / 2 : ℕ) : ℝ) + 1 = m := by exact_mod_cast h - linarith only [h'] - have e2 : paddedJobs m n ε ⟨2 * m - 1, by omega⟩ = m := by - change paddedJobLength m ε (2 * m - 1) = m - rw [fc_len_lt m ε (2 * m - 1) (by omega)] - have h : (2 * m - 1) / 2 + 1 = m := by omega - have h' : (((2 * m - 1) / 2 : ℕ) : ℝ) + 1 = m := by exact_mod_cast h - linarith only [h'] - have e3 : paddedJobs m n ε ⟨2 * m, by omega⟩ = m := fc_len_two_mul m ε - rw [e1, e2, e3] - linarith only [hB] + obtain ⟨ρ, hρ⟩ := tg_exists_opt m + let τ : Fin n → Fin m := fun j => + if hj : (j : ℕ) < 2 * m + 1 then ρ ⟨j, hj⟩ else 0 + have hτ : τ ∘ Fin.castLE hn = ρ := by + funext j + simp only [τ, Function.comp_apply, Fin.val_castLE, j.isLt, ↓reduceDIte] + have hprefix (i : Fin m) : loadBefore (paddedJobs m n ε) τ (2 * m + 1) i = 3 * m := by + rw [← loadBefore_restrict hn _ τ (2 * m + 1) le_rfl i, + paddedJobs_restrict m n ε hn, hτ, bs_loadBefore_of_le _ _ _ le_rfl] + exact hρ i + refine ⟨τ, fun i => ?_⟩ + have hload := load_le_loadBefore_add (paddedJobs m n ε) τ (2 * m + 1) ε hε0 + (fun j hj => by + change paddedJobLength m ε j ≤ ε + rw [fc_len_gt m ε j (by omega)]) i + rwa [hprefix i] at hload /-- The optimum of the family is at most `3m + nε`. -/ theorem fc_optMakespan_le (m n : ℕ) [NeZero m] (ε : ℝ) (hε0 : 0 ≤ ε) (hn : 2 * m + 1 ≤ n) : From 3fa7de32378bfd36c36a85a7e3f75934e4f20350 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 20 Oct 2026 12:38:44 +0000 Subject: [PATCH 5/5] Share generic prefix sum identities across scheduling proofs --- LeanPool/GrahamLPT/Basic.lean | 60 ++++++++++++++++------------ LeanPool/GrahamLPT/CoffmanSethi.lean | 54 ++----------------------- 2 files changed, 39 insertions(+), 75 deletions(-) diff --git a/LeanPool/GrahamLPT/Basic.lean b/LeanPool/GrahamLPT/Basic.lean index ececd15be7..fa65f39d51 100644 --- a/LeanPool/GrahamLPT/Basic.lean +++ b/LeanPool/GrahamLPT/Basic.lean @@ -25,18 +25,15 @@ namespace GrahamLPT open Finset -/-- No job has index below `0`. -/ -theorem bs_loadBefore_zero {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : Fin m) : - loadBefore p σ 0 i = 0 := by - simp [loadBefore] - -/-- Adding the job `k`. -/ -theorem bs_loadBefore_succ {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (k : Fin n) (i : Fin m) : - loadBefore p σ (k + 1) i = loadBefore p σ k i + if σ k = i then p k else 0 := by - unfold loadBefore +/-- Adding one job to a prefix sum, for arbitrary commutative additive values. -/ +theorem sum_prefix_succ {M : Type*} [AddCommMonoid M] {m n : ℕ} (f : Fin n → M) + (σ : Fin n → Fin m) (k : Fin n) (i : Fin m) : + ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1 ∧ σ j = i), f j = + (∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), f j) + if σ k = i then f k else + 0 := by rw [Finset.sum_filter, Finset.sum_filter] - have e : (if σ k = i then p k else 0) = - ∑ j : Fin n, if j = k then (if σ j = i then p j else 0) else 0 := by + have e : (if σ k = i then f k else 0) = + ∑ j : Fin n, if j = k then (if σ j = i then f j else 0) else 0 := by rw [Finset.sum_ite_eq'] simp rw [e, ← Finset.sum_add_distrib] @@ -51,6 +48,29 @@ theorem bs_loadBefore_succ {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m · have h2 : ¬ (j : ℕ) < k + 1 := by omega simp [hjk, h1, h2] +/-- Summing the machine fibers recovers the total prefix weight. -/ +theorem sum_prefix_fiber {M : Type*} [AddCommMonoid M] {m n : ℕ} (f : Fin n → M) (σ : Fin n → Fin m) + (k : ℕ) : + ∑ i, ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), f j = + ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k), f j := by + simp only [Finset.sum_filter] + rw [Finset.sum_comm] + refine Finset.sum_congr rfl fun j _ => ?_ + simp only [ite_and] + by_cases h : (j : ℕ) < k + · simp [h, Finset.sum_ite_eq] + · simp [h] + +/-- No job has index below `0`. -/ +theorem bs_loadBefore_zero {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (i : Fin m) : + loadBefore p σ 0 i = 0 := by + simp [loadBefore] + +/-- Adding the job `k`. -/ +theorem bs_loadBefore_succ {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (k : Fin n) (i : Fin m) : + loadBefore p σ (k + 1) i = loadBefore p σ k i + if σ k = i then p k else 0 := + sum_prefix_succ p σ k i + /-- At or beyond the last index, `loadBefore` is the load. -/ theorem bs_loadBefore_of_le {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (k : ℕ) (hk : n ≤ k) (i : Fin m) : @@ -114,23 +134,13 @@ theorem IsListSchedule.restrict {m n N : ℕ} (h : n ≤ N) (p : Fin N → ℝ) /-- The loads before `k` sum to the lengths of the jobs before `k`. -/ theorem bs_sum_loadBefore {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) (k : ℕ) : - ∑ i, loadBefore p σ k i = ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k), p j := by - unfold loadBefore - simp only [Finset.sum_filter] - rw [Finset.sum_comm] - refine Finset.sum_congr rfl fun j _ => ?_ - simp only [ite_and] - by_cases h : (j : ℕ) < k - · simp [h, Finset.sum_ite_eq] - · simp [h] + ∑ i, loadBefore p σ k i = ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k), p j := + sum_prefix_fiber p σ k /-- The loads sum to the total length. -/ theorem bs_sum_load {m n : ℕ} (p : Fin n → ℝ) (σ : Fin n → Fin m) : ∑ i, load p σ i = ∑ j, p j := by - unfold load - simp only [Finset.sum_filter] - rw [Finset.sum_comm] - refine Finset.sum_congr rfl fun j _ => ?_ - simp [Finset.sum_ite_eq] + simpa only [bs_loadBefore_of_le p σ n le_rfl, Fin.isLt, filter_true] using + bs_sum_loadBefore p σ n /-- The lengths of the jobs before `k`, plus `p k`, are at most the total (nonnegative lengths). -/ theorem bs_sum_filter_add_le {n : ℕ} (p : Fin n → ℝ) (hp : ∀ j, 0 ≤ p j) (k : Fin n) : diff --git a/LeanPool/GrahamLPT/CoffmanSethi.lean b/LeanPool/GrahamLPT/CoffmanSethi.lean index 01d694f17e..208e7d10e6 100644 --- a/LeanPool/GrahamLPT/CoffmanSethi.lean +++ b/LeanPool/GrahamLPT/CoffmanSethi.lean @@ -59,52 +59,6 @@ count. -/ def loadDifferenceInvariant (P D y : ℝ) (Φ : ℤ) : Prop := (0 ≤ D → ⌊D / P⌋ ≤ Φ) ∧ (D < 0 → -1 ≤ Φ ∧ ⌊(D + y) / P⌋ - 1 ≤ Φ) -theorem cs_sum_succ {M : Type*} [AddCommMonoid M] {m n : ℕ} (f : Fin n → M) (σ : Fin n → Fin m) (k - : Fin n) - (i : Fin m) : - ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1 ∧ σ j = i), f j = - (∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), f j) + if σ k = i then f k else - 0 := by - by_cases h : σ k = i - · have e : univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1 ∧ σ j = i) = - insert k (univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i)) := by - ext j - simp only [mem_filter, mem_univ, true_and, mem_insert] - constructor - · rintro ⟨h1, h2⟩ - by_cases hjk : j = k - · exact Or.inl hjk - · have : (j : ℕ) ≠ k := fun e => hjk (Fin.ext e) - exact Or.inr ⟨by omega, h2⟩ - · rintro (rfl | ⟨h1, h2⟩) - · exact ⟨by omega, h⟩ - · exact ⟨by omega, h2⟩ - rw [e, sum_insert (by simp), ite_eq_left h, add_comm] - · have e : univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1 ∧ σ j = i) = - univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i) := by - ext j - simp only [mem_filter, mem_univ, true_and] - constructor - · rintro ⟨h1, h2⟩ - have hjk : j ≠ k := fun e => h (e ▸ h2) - have : (j : ℕ) ≠ k := fun e => hjk (Fin.ext e) - exact ⟨by omega, h2⟩ - · rintro ⟨h1, h2⟩ - exact ⟨by omega, h2⟩ - rw [e, ite_eq_right h, add_zero] - -theorem cs_sum_fiber {M : Type*} [AddCommMonoid M] {m n : ℕ} (f : Fin n → M) (σ : Fin n → Fin m) - (k : ℕ) : - ∑ i, ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), f j = - ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k), f j := by - simp only [Finset.sum_filter] - rw [Finset.sum_comm] - refine Finset.sum_congr rfl fun j _ => ?_ - simp only [ite_and] - by_cases h : (j : ℕ) < k - · simp [h, Finset.sum_ite_eq] - · simp [h] - theorem cs_inv_mono {P D y y' : ℝ} {Φ : ℤ} (hP : 0 < P) (h : loadDifferenceInvariant P D y Φ) (hy : y' ≤ y) : loadDifferenceInvariant P D y' Φ := by @@ -207,9 +161,9 @@ theorem cs_inv_all {m n : ℕ} (p : Fin n → ℝ) (hanti : Antitone p) (σ : Fi fun i => bs_loadBefore_succ p σ kk i have eF : ∀ i, prefixJobWeight p P σ (k + 1) i = prefixJobWeight p P σ k i + if σ kk = i then ⌊p kk / P⌋ else 0 := - fun i => cs_sum_succ (fun j => ⌊p j / P⌋) σ kk i + fun i => sum_prefix_succ (fun j => ⌊p j / P⌋) σ kk i have eC : ∀ i, prefixJobCount σ (k + 1) i = prefixJobCount σ k i + if σ kk = i then 1 else 0 := - fun i => cs_sum_succ (fun _ => (1 : ℤ)) σ kk i + fun i => sum_prefix_succ (fun _ => (1 : ℤ)) σ kk i have hmin : ∀ i, loadBefore p σ k (σ kk) ≤ loadBefore p σ k i := fun i => hσ kk i rw [eL h, eL g, eF h, eC g] by_cases h1 : σ kk = h @@ -290,7 +244,7 @@ theorem lpt_job_position_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ have hlow : (m : ℤ) * c + 1 ≤ ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1), ⌊p j / p k⌋ := by rw [e, sum_insert (by simp), div_self hpos.ne', Int.floor_one, - ← cs_sum_fiber (fun j => ⌊p j / p k⌋) σ k] + ← sum_prefix_fiber (fun j => ⌊p j / p k⌋) σ k] have h1 : ∑ _i : Fin m, (c : ℤ) ≤ ∑ i, ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < k ∧ σ j = i), ⌊p j / p k⌋ := Finset.sum_le_sum fun i _ => by @@ -326,7 +280,7 @@ theorem lpt_job_position_le {m n : ℕ} [NeZero m] (p : Fin n → ℝ) (hp : ∀ omega have hup : ∑ j ∈ univ.filter (fun j : Fin n => (j : ℕ) < (k : ℕ) + 1), ⌊p j / p k⌋ ≤ (m : ℤ) * c := by - rw [← cs_sum_fiber (fun j => ⌊p j / p k⌋) τ ((k : ℕ) + 1)] + rw [← sum_prefix_fiber (fun j => ⌊p j / p k⌋) τ ((k : ℕ) + 1)] have h1 := Finset.sum_le_sum fun g (_ : g ∈ (univ : Finset (Fin m))) => hfib g simp only [sum_const, card_univ, Fintype.card_fin, nsmul_eq_mul] at h1 exact h1