From 8be8d07811a58ccccd3c52ac2eb83177bc904920 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Thu, 26 Feb 2026 01:22:55 +0100 Subject: [PATCH 01/75] Big PR Author : Shreyas Srinivas Co-Author : Eric Wieser Co-Author : Tanner Duve --- Cslib.lean | 11 +- .../Algorithms/ListInsertionSort.lean | 100 +++++++++ .../Algorithms/ListLinearSearch.lean | 83 +++++++ .../Algorithms/ListOrderedInsert.lean | 96 ++++++++ .../Algorithms/MergeSort.lean | 207 ++++++++++++++++++ .../Lean/MergeSort/MergeSort.lean | 6 +- .../Lean/TimeM.lean | 0 .../Models/ListComparisonSearch.lean | 54 +++++ .../Models/ListComparisonSort.lean | 146 ++++++++++++ Cslib/AlgorithmsTheory/QueryModel.lean | 150 +++++++++++++ Cslib/Foundations/Control/Monad/Free.lean | 18 +- CslibTests.lean | 2 + CslibTests/QueryModel/ProgExamples.lean | 122 +++++++++++ CslibTests/QueryModel/QueryExamples.lean | 77 +++++++ 14 files changed, 1065 insertions(+), 7 deletions(-) create mode 100644 Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean create mode 100644 Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean create mode 100644 Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean create mode 100644 Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean rename Cslib/{Algorithms => AlgorithmsTheory}/Lean/MergeSort/MergeSort.lean (97%) rename Cslib/{Algorithms => AlgorithmsTheory}/Lean/TimeM.lean (100%) create mode 100644 Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean create mode 100644 Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean create mode 100644 Cslib/AlgorithmsTheory/QueryModel.lean create mode 100644 CslibTests/QueryModel/ProgExamples.lean create mode 100644 CslibTests/QueryModel/QueryExamples.lean diff --git a/Cslib.lean b/Cslib.lean index 8905be5f9..be342da0d 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,7 +1,14 @@ module -- shake: keep-all -public import Cslib.Algorithms.Lean.MergeSort.MergeSort -public import Cslib.Algorithms.Lean.TimeM +public import Cslib.AlgorithmsTheory.Algorithms.ListInsertionSort +public import Cslib.AlgorithmsTheory.Algorithms.ListLinearSearch +public import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert +public import Cslib.AlgorithmsTheory.Algorithms.MergeSort +public import Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort +public import Cslib.AlgorithmsTheory.Lean.TimeM +public import Cslib.AlgorithmsTheory.Models.ListComparisonSearch +public import Cslib.AlgorithmsTheory.Models.ListComparisonSort +public import Cslib.AlgorithmsTheory.QueryModel public import Cslib.Computability.Automata.Acceptors.Acceptor public import Cslib.Computability.Automata.Acceptors.OmegaAcceptor public import Cslib.Computability.Automata.DA.Basic diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean new file mode 100644 index 000000000..86c85c3ee --- /dev/null +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 Shreyas Srinivas. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Shreyas Srinivas, Eric Wieser +-/ +module + +public import Cslib.AlgorithmsTheory.QueryModel +public import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert +public import Mathlib + +@[expose] public section + +/-! +# Insertion sort in a list + +In this file we state and prove the correctness and complexity of insertion sort in lists under +the `SortOps` model. This insertionSort evaluates identically to the upstream version of +`List.insertionSort` +-- + +## Main Definitions + +- `insertionSort` : Insertion sort algorithm in the `SortOps` query model + +## Main results + +- `insertionSort_eval`: `insertionSort` evaluates identically to `List.insertionSort`. +- `insertionSort_permutation` : `insertionSort` outputs a permutation of the input list. +- `insertionSort_sorted` : `insertionSort` outputs a sorted list. +- `insertionSort_complexity` : `insertionSort` takes at most n * (n + 1) comparisons and + (n + 1) * (n + 2) list head-insertions. +-/ + +namespace Cslib + +namespace Algorithms + +open Prog + +/-- The insertionSort algorithms on lists with the `SortOps` query. -/ +def insertionSort (l : List α) : Prog (SortOps α) (List α) := + match l with + | [] => return [] + | x :: xs => do + let rest ← insertionSort xs + insertOrd x rest + +@[simp] +theorem insertionSort_eval (l : List α) (le : α → α → Prop) [DecidableRel le] : + (insertionSort l).eval (sortModel le) = l.insertionSort le := by + induction l with simp_all [insertionSort] + +theorem insertionSort_permutation (l : List α) (le : α → α → Prop) [DecidableRel le] : + ((insertionSort l).eval (sortModel le)).Perm l := by + simp [insertionSort_eval, List.perm_insertionSort] + +theorem insertionSort_sorted + (l : List α) (le : α → α → Prop) [DecidableRel le] [Std.Total le] [IsTrans α le] : + ((insertionSort l).eval (sortModel le)).Pairwise le := by + simpa using List.pairwise_insertionSort _ _ + +lemma insertionSort_length (l : List α) (le : α → α → Prop) [DecidableRel le] : + ((insertionSort l).eval (sortModel le)).length = l.length := by + simp + +lemma insertionSort_time_compares (head : α) (tail : List α) (le : α → α → Prop) [DecidableRel le] : + ((insertionSort (head :: tail)).time (sortModel le)).compares = + ((insertionSort tail).time (sortModel le)).compares + + ((insertOrd head (tail.insertionSort le)).time (sortModel le)).compares := by + simp [insertionSort] + +lemma insertionSort_time_inserts (head : α) (tail : List α) (le : α → α → Prop) [DecidableRel le] : + ((insertionSort (head :: tail)).time (sortModel le)).inserts = + ((insertionSort tail).time (sortModel le)).inserts + + ((insertOrd head (tail.insertionSort le)).time (sortModel le)).inserts := by + simp [insertionSort] + +theorem insertionSort_complexity (l : List α) (le : α → α → Prop) [DecidableRel le] : + ((insertionSort l).time (sortModel le)) + ≤ ⟨l.length * (l.length + 1), (l.length + 1) * (l.length + 2)⟩ := by + induction l with + | nil => + simp [insertionSort] + | cons head tail ih => + have h := insertOrd_complexity_upper_bound (tail.insertionSort le) head le + simp_all only [List.length_cons, List.length_insertionSort] + obtain ⟨ih₁,ih₂⟩ := ih + obtain ⟨h₁,h₂⟩ := h + refine ⟨?_, ?_⟩ + · clear h₂ + rw [insertionSort_time_compares] + nlinarith [ih₁, h₁] + · clear h₁ + rw [insertionSort_time_inserts] + nlinarith [ih₂, h₂] + +end Algorithms + +end Cslib diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean new file mode 100644 index 000000000..0a1f5c3a9 --- /dev/null +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Shreyas Srinivas. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Shreyas Srinivas, Eric Wieser +-/ + +module + +public import Cslib.AlgorithmsTheory.QueryModel +public import Cslib.AlgorithmsTheory.Models.ListComparisonSearch +public import Mathlib + +@[expose] public section + +/-! +# Linear search in a list + +In this file we state and prove the correctness and complexity of linear search in lists under +the `ListSearch` model. +-- + +## Main Definitions + +- `listLinearSearch` : Linear search algorithm in the `ListSearch` query model + +## Main results + +- `listLinearSearch_eval`: `insertOrd` evaluates identically to `List.contains`. +- `listLinearSearchM_time_complexity_upper_bound` : `linearSearch` takes at most `n` + comparison operations +- `listLinearSearchM_time_complexity_lower_bound` : There exist lists on which `linearSearch` needs + `n` comparisons +-/ +namespace Cslib + +namespace Algorithms + +open Prog + +open ListSearch in +/-- Linear Search in Lists on top of the `ListSearch` query model. -/ +def listLinearSearch (l : List α) (x : α) : Prog (ListSearch α) Bool := do + match l with + | [] => return false + | l :: ls => + let cmp : Bool ← compare (l :: ls) x + if cmp then + return true + else + listLinearSearch ls x + +@[simp, grind =] +lemma listLinearSearch_eval [BEq α] (l : List α) (x : α) : + (listLinearSearch l x).eval ListSearch.natCost = l.contains x := by + fun_induction l.elem x with simp_all [listLinearSearch] + +lemma listLinearSearchM_correct_true [BEq α] [LawfulBEq α] (l : List α) + {x : α} (x_mem_l : x ∈ l) : (listLinearSearch l x).eval ListSearch.natCost = true := by + simp [x_mem_l] + +lemma listLinearSearchM_correct_false [BEq α] [LawfulBEq α] (l : List α) + {x : α} (x_mem_l : x ∉ l) : (listLinearSearch l x).eval ListSearch.natCost = false := by + simp [x_mem_l] + +lemma listLinearSearchM_time_complexity_upper_bound [BEq α] (l : List α) (x : α) : + (listLinearSearch l x).time ListSearch.natCost ≤ l.length := by + fun_induction l.elem x with + | case1 => simp [listLinearSearch] + | case2 => simp_all [listLinearSearch] + | case3 => + simp_all [listLinearSearch] + grind + +-- This statement is wrong +lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [Nonempty α] : + ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch.natCost = l.length := by + inhabit α + refine ⟨[], default, ?_⟩ + simp_all [ListSearch.natCost, listLinearSearch] + +end Algorithms + +end Cslib diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean new file mode 100644 index 000000000..4a0ebfb93 --- /dev/null +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -0,0 +1,96 @@ +/- +Copyright (c) 2026 Shreyas Srinivas. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Shreyas Srinivas, Eric Wieser +-/ + +module + +public import Cslib.AlgorithmsTheory.QueryModel +public import Cslib.AlgorithmsTheory.Models.ListComparisonSort +public import Mathlib + +@[expose] public section + +/-! +# Ordered insertion in a list + +In this file we state and prove the correctness and complexity of ordered insertions in lists under +the `SortOps` model. This ordered insert is later used in `insertionSort` mirroring the structure +in upstream libraries for the pure lean code versions of these declarations. + +-- + +## Main Definitions + +- `insertOrd` : ordered insert algorithm in the `SortOps` query model + +## Main results + +- `insertOrd_eval`: `insertOrd` evaluates identically to `List.orderedInsert`. +- `insertOrd_complexity_upper_bound` : Shows that `insertOrd` takes at most `n` comparisons, + and `n + 1` list head-insertion operations. +- `insertOrd_sorted` : Applying `insertOrd` to a sorted list yields a sorted list. +-/ + +namespace Cslib +namespace Algorithms + +open Prog + +open SortOps + +/-- +Performs ordered insertion of `x` into a list `l` in the `SortOps` query model. +If `l` is sorted, then `x` is inserted into `l` such that the resultant list is also sorted. +-/ +def insertOrd (x : α) (l : List α) : Prog (SortOps α) (List α) := do + match l with + | [] => insertHead x l + | a :: as => + if (← cmpLE x a : Bool) then + insertHead x (a :: as) + else + let res ← insertOrd x as + insertHead a res + +@[simp] +lemma insertOrd_eval (x : α) (l : List α) (le : α → α → Prop) [DecidableRel le] : + (insertOrd x l).eval (sortModel le) = l.orderedInsert le x := by + induction l with + | nil => + simp [insertOrd, sortModel] + | cons head tail ih => + by_cases h_head : le x head + · simp [insertOrd, h_head] + · simp [insertOrd, h_head, ih] + +-- to upstream +@[simp] +lemma _root_.List.length_orderedInsert (x : α) (l : List α) [DecidableRel r] : + (l.orderedInsert r x).length = l.length + 1 := by + induction l <;> grind + +theorem insertOrd_complexity_upper_bound + (l : List α) (x : α) (le : α → α → Prop) [DecidableRel le] : + (insertOrd x l).time (sortModel le) ≤ ⟨l.length, l.length + 1⟩ := by + induction l with + | nil => + simp [insertOrd, sortModel] + | cons head tail ih => + obtain ⟨ih_compares, ih_inserts⟩ := ih + rw [insertOrd] + by_cases h_head : le x head + · simp [h_head] + · simp [h_head] + grind + +lemma insertOrd_sorted + (l : List α) (x : α) (le : α → α → Prop) [DecidableRel le] [Std.Total le] [IsTrans _ le] : + l.Pairwise le → ((insertOrd x l).eval (sortModel le)).Pairwise le := by + rw [insertOrd_eval] + exact List.Pairwise.orderedInsert _ _ + +end Algorithms + +end Cslib diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean new file mode 100644 index 000000000..a2a235984 --- /dev/null +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -0,0 +1,207 @@ +/- +Copyright (c) 2026 Shreyas Srinivas. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Shreyas Srinivas, Eric Wieser +-/ + +module + +public import Cslib.AlgorithmsTheory.QueryModel +public import Cslib.AlgorithmsTheory.Models.ListComparisonSort +public import Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort +import all Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort +import all Init.Data.List.Sort.Basic +@[expose] public section + +/-! +# Merge sort in a list + +In this file we state and prove the correctness and complexity of merge sort in lists under +the `SortOps` model. +-- + +## Main Definitions +- `merge` : Merge algorithm for merging two sorted lists in the `SortOps` query model +- `mergeSort` : Merge sort algorithm in the `SortOps` query model + +## Main results + +- `mergeSort_eval`: `mergeSort` evaluates identically to the priva. +- `mergeSort_sorted` : `mergeSort` outputs a sorted list. +- `mergeSort_perm` : The output of `mergeSort` is a permutation of the input list +- `mergeSort_complexity` : `mergeSort` takes at most n * ⌈log n⌉ comparisons. +-/ +namespace Cslib.Algorithms + +open SortOpsCmp + +/-- Merge two sorted lists using comparisons in the query monad. -/ +@[simp] +def merge (x y : List α) : Prog (SortOpsCmp α) (List α) := do + match x,y with + | [], ys => return ys + | xs, [] => return xs + | x :: xs', y :: ys' => do + let cmp : Bool ← cmpLE x y + if cmp then + let rest ← merge xs' (y :: ys') + return (x :: rest) + else + let rest ← merge (x :: xs') ys' + return (y :: rest) + +lemma merge_timeComplexity (x y : List α) (le : α → α → Prop) [DecidableRel le] : + (merge x y).time (sortModelNat le) ≤ x.length + y.length := by + fun_induction List.merge x y (le · ·) with + | case1 => simp + | case2 => simp + | case3 x xs y ys hxy ihx => + suffices 1 + (merge xs (y :: ys)).time (sortModelNat le) ≤ xs.length + 1 + (ys.length + 1) by + simpa [hxy] + grind + | case4 x xs y ys hxy ihy => + suffices 1 + (merge (x :: xs) ys).time (sortModelNat le) ≤ xs.length + 1 + (ys.length + 1) by + simpa [hxy] + grind + +@[simp] +lemma merge_eval (x y : List α) (le : α → α → Prop) [DecidableRel le] : + (merge x y).eval (sortModelNat le) = List.merge x y (le · ·) := by + fun_induction List.merge with + | case1 => simp + | case2 => simp + | case3 x xs y ys ihx ihy => simp_all [merge] + | case4 x xs y ys hxy ihx => + rw [decide_eq_true_iff] at hxy + simp_all [merge, -not_le] + +lemma merge_length (x y : List α) (le : α → α → Prop) [DecidableRel le] : + ((merge x y).eval (sortModelNat le)).length = x.length + y.length := by + rw [merge_eval] + apply List.length_merge + +/-- +The `mergeSort` algorithm in the `SortOps` query model. It sorts the input list +according to the mergeSort algorithm. +-/ +def mergeSort (xs : List α) : Prog (SortOpsCmp α) (List α) := do + if xs.length < 2 then return xs + else + let half := xs.length / 2 + let left := xs.take half + let right := xs.drop half + let sortedLeft ← mergeSort left + let sortedRight ← mergeSort right + merge sortedLeft sortedRight + +/-- +The vanilla-lean version of `mergeSortNaive` that is extensionally equal to `mergeSort` +-/ +private def mergeSortNaive (xs : List α) (le : α → α → Prop) [DecidableRel le] : List α := + if xs.length < 2 then xs + else + let sortedLeft := mergeSortNaive (xs.take (xs.length/2)) le + let sortedRight := mergeSortNaive (xs.drop (xs.length/2)) le + List.merge sortedLeft sortedRight (le · ·) + +private proof_wanted mergeSortNaive_eq_mergeSort + [LinearOrder α] (xs : List α) (le : α → α → Prop) [DecidableRel le] : + mergeSortNaive xs le = xs.mergeSort + +private lemma mergeSortNaive_Perm (xs : List α) (le : α → α → Prop) [DecidableRel le] : + (mergeSortNaive xs le).Perm xs := by + fun_induction mergeSortNaive + · simp + · expose_names + rw [←(List.take_append_drop (x.length / 2) x)] + grw [List.merge_perm_append, ← ih1, ← ih2] + +@[simp] +private lemma mergeSort_eval (xs : List α) (le : α → α → Prop) [DecidableRel le] : + (mergeSort xs).eval (sortModelNat le) = mergeSortNaive xs le := by + fun_induction mergeSort with + | case1 xs h => + simp [h, mergeSortNaive, Prog.eval] + | case2 xs h n left right ihl ihr => + rw [mergeSortNaive, if_neg h] + have im := merge_eval left right + simp [ihl, ihr, merge_eval] + rfl + +private lemma mergeSortNaive_length (xs : List α) (le : α → α → Prop) [DecidableRel le] : + (mergeSortNaive xs le).length = xs.length := by + fun_induction mergeSortNaive with + | case1 xs h => + simp + | case2 xs h left right ihl ihr => + rw [List.length_merge] + convert congr($ihl + $ihr) + rw [← List.length_append] + simp + +lemma mergeSort_length (xs : List α) (le : α → α → Prop) [DecidableRel le] : + ((mergeSort xs).eval (sortModelNat le)).length = xs.length := by + rw [mergeSort_eval] + apply mergeSortNaive_length + +lemma merge_sorted_sorted + (xs ys : List α) (le : α → α → Prop) [DecidableRel le] [Std.Total le] [IsTrans _ le] + (hxs_mono : xs.Pairwise le) (hys_mono : ys.Pairwise le) : + ((merge xs ys).eval (sortModelNat le)).Pairwise le := by + rw [merge_eval] + grind [hxs_mono.merge hys_mono] + +private lemma mergeSortNaive_sorted + (xs : List α) (le : α → α → Prop) [DecidableRel le] [Std.Total le] [IsTrans _ le] : + (mergeSortNaive xs le).Pairwise le := by + fun_induction mergeSortNaive with + | case1 xs h => + match xs with | [] | [x] => simp + | case2 xs h left right ihl ihr => + simpa using ihl.merge ihr + +theorem mergeSort_sorted + (xs : List α) (le : α → α → Prop) [DecidableRel le] [Std.Total le] [IsTrans _ le] : + ((mergeSort xs).eval (sortModelNat le)).Pairwise le := by + rw [mergeSort_eval] + apply mergeSortNaive_sorted + +theorem mergeSort_perm (xs : List α) (le : α → α → Prop) [DecidableRel le] : + ((mergeSort xs).eval (sortModelNat le)).Perm xs := by + rw [mergeSort_eval] + apply mergeSortNaive_Perm + +section TimeComplexity + +open Cslib.Algorithms.Lean.TimeM + +-- TODO: reuse the work in `mergeSort_time_le`? +theorem mergeSort_complexity (xs : List α) (le : α → α → Prop) [DecidableRel le] : + (mergeSort xs).time (sortModelNat le) ≤ T (xs.length) := by + fun_induction mergeSort + · simp [T] + · expose_names + simp only [FreeM.bind_eq_bind, Prog.time_bind, mergeSort_eval] + grw [merge_timeComplexity, ih1, ih2, mergeSortNaive_length, mergeSortNaive_length] + set n := x.length + have hleft_len : left.length ≤ n / 2 := by + grind + have hright_len : right.length ≤ (n + 1) / 2 := by + have hright_eq : right.length = n - n / 2 := by + simp [right, n, half, List.length_drop] + rw [hright_eq] + grind + have htleft_len : T left.length ≤ T (n / 2) := T_monotone hleft_len + have htright_len : T right.length ≤ T ((n + 1) / 2) := T_monotone hright_len + grw [htleft_len, htright_len, hleft_len, hright_len] + have hs := some_algebra (n - 2) + have hsub1 : (n - 2) / 2 + 1 = n / 2 := by grind + have hsub2 : 1 + (1 + (n - 2)) / 2 = (n + 1) / 2 := by grind + have hsub3 : (n - 2) + 2 = n := by grind + have hsplit : n / 2 + (n + 1) / 2 = n := by grind + simpa [T, hsub1, hsub2, hsub3, hsplit, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] + using hs + +end TimeComplexity + +end Cslib.Algorithms diff --git a/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean b/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean similarity index 97% rename from Cslib/Algorithms/Lean/MergeSort/MergeSort.lean rename to Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean index 8ba55d461..081dbf1b7 100644 --- a/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean @@ -6,7 +6,7 @@ Authors: Sorrachai Yingchareonthawornhcai module -public import Cslib.Algorithms.Lean.TimeM +public import Cslib.AlgorithmsTheory.Lean.TimeM public import Mathlib.Data.Nat.Cast.Order.Ring public import Mathlib.Data.Nat.Lattice public import Mathlib.Data.Nat.Log @@ -158,6 +158,10 @@ private lemma some_algebra (n : ℕ) : /-- Upper bound function for merge sort time complexity: `T(n) = n * ⌈log₂ n⌉` -/ abbrev T (n : ℕ) : ℕ := n * clog 2 n +lemma T_monotone : Monotone T := by + intro i j h_ij + exact Nat.mul_le_mul h_ij (Nat.clog_monotone 2 h_ij) + /-- Solve the recurrence -/ theorem timeMergeSortRec_le (n : ℕ) : timeMergeSortRec n ≤ T n := by fun_induction timeMergeSortRec with diff --git a/Cslib/Algorithms/Lean/TimeM.lean b/Cslib/AlgorithmsTheory/Lean/TimeM.lean similarity index 100% rename from Cslib/Algorithms/Lean/TimeM.lean rename to Cslib/AlgorithmsTheory/Lean/TimeM.lean diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean new file mode 100644 index 000000000..888f223bc --- /dev/null +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2025 Shreyas Srinivas. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Shreyas Srinivas +-/ + +module + +public import Cslib.AlgorithmsTheory.QueryModel +public import Mathlib + +@[expose] public section + +/-! +# Query Type for Comparison Search in Lists + +In this file we define a query type `ListSearch` for comparison based searching in Lists, +whose sole query `compare` compares the head of the list with a given argument. It +further defines a model `ListSearch.natCost` for this query. + +-- +## Definitions + +- `ListSearch`: A query type for comparison based search in lists. +- `ListSearch.natCost`: A model for this query with costs in `ℕ`. + +-/ + +namespace Cslib + +namespace Algorithms + +open Prog + +/-- +A query type for searching elements in list. It supports exactly one query +`compare l val` which returns `true` if the head of the list `l` is equal to `val` +and returns `false` otherwise. +-/ +inductive ListSearch (α : Type*) : Type → Type _ where + | compare (a : List α) (val : α) : ListSearch α Bool + + +/-- A model of the `ListSearch` query type that assigns the cost as the number of queries. -/ +@[simps] +def ListSearch.natCost [BEq α] : Model (ListSearch α) ℕ where + evalQuery + | .compare l x => some x == l.head? + cost + | .compare _ _ => 1 + +end Algorithms + +end Cslib diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean new file mode 100644 index 000000000..5aad6b123 --- /dev/null +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -0,0 +1,146 @@ +/- +Copyright (c) 2026 Shreyas Srinivas. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Shreyas Srinivas, Eric WIeser +-/ + +module + +public import Cslib.AlgorithmsTheory.QueryModel + +@[expose] public section + +/-! +# Query Type for Comparison Search in Lists + +In this file we define two query types `SortOps` which is suitable for insertion sort, and +`SortOps`for comparison based searching in Lists. We define a model `sortModel` for `SortOps` +which uses a custom cost structure `SortOpsCost`. We define a model `sortModelCmp` for `SortOpsCmp` +which defines a `ℕ` based cost structure. +-- +## Definitions + +- `SortOps`: A query type for comparison based sorting in lists which includes queries for + comparison and head-insertion into Lists. This is a suitable query for ordered insertion + and insertion sort. +- `SortOpsCmp`: A query type for comparison based sorting that only includes a comparison query. + This is more suitable for comparison based sorts for which it is only desirable to count + comparisons + +-/ +namespace Cslib + +namespace Algorithms + +open Prog + +/-- +A model for comparison sorting on lists. +-/ +inductive SortOps (α : Type) : Type → Type where + /-- `cmpLE x y` is intended to return `true` if `x ≤ y` and `false` otherwise. + The specific order relation depends on the model provided for this typ. e-/ + | cmpLE (x : α) (y : α) : SortOps α Bool + /-- `insertHead l x` is intended to return `x :: l`. -/ + | insertHead (x : α) (l : List α) : SortOps α (List α) + +open SortOps + +section SortOpsCostModel + +/-- +A cost type for counting the operations of `SortOps` with separate fields for +counting calls to `cmpLT` and `insertHead` +-/ +@[ext, grind] +structure SortOpsCost where + /-- `compares` counts the number of calls to `cmpLT` -/ + compares : ℕ + /-- `inserts` counts the number of calls to `insertHead` -/ + inserts : ℕ + +/-- Equivalence between SortOpsCost and a product type. -/ +def SortOpsCost.equivProd : SortOpsCost ≃ (ℕ × ℕ) where + toFun sortOps := (sortOps.compares, sortOps.inserts) + invFun pair := ⟨pair.1, pair.2⟩ + left_inv _ := rfl + right_inv _ := rfl + +namespace SortOpsCost + +@[simps, grind] +instance : Zero SortOpsCost := ⟨0, 0⟩ + +@[simps] +instance : LE SortOpsCost where + le soc₁ soc₂ := soc₁.compares ≤ soc₂.compares ∧ soc₁.inserts ≤ soc₂.inserts + +instance : LT SortOpsCost where + lt soc₁ soc₂ := soc₁ ≤ soc₂ ∧ ¬soc₂ ≤ soc₁ + +@[grind] +instance : PartialOrder SortOpsCost := + fast_instance% SortOpsCost.equivProd.injective.partialOrder _ .rfl .rfl + +@[simps] +instance : Add SortOpsCost where + add soc₁ soc₂ := ⟨soc₁.compares + soc₂.compares, soc₁.inserts + soc₂.inserts⟩ + +@[simps] +instance : SMul ℕ SortOpsCost where + smul n soc := ⟨n • soc.compares, n • soc.inserts⟩ + +instance : AddCommMonoid SortOpsCost := + fast_instance% + SortOpsCost.equivProd.injective.addCommMonoid _ rfl (fun _ _ => rfl) (fun _ _ => rfl) + +end SortOpsCost + +/-- +A model of `SortOps` that uses `SortOpsCost` as the cost type for operations. + +While this accepts any decidable relation `le`, most sorting algorithms are only well-behaved in the +presence of `[Std.Total le] [IsTrans _ le]`. +-/ +@[simps, grind] +def sortModel {α : Type} (le : α → α → Prop) [DecidableRel le] : Model (SortOps α) SortOpsCost where + evalQuery + | .cmpLE x y => decide (le x y) + | .insertHead x l => x :: l + cost + | .cmpLE _ _ => ⟨1,0⟩ + | .insertHead _ _ => ⟨0,1⟩ + +end SortOpsCostModel + +section NatModel + +/-- +A model for comparison sorting on lists with only the comparison operation. This +is used in mergeSort. +-/ +inductive SortOpsCmp.{u} (α : Type u) : Type → Type _ where + /-- `cmpLE x y` is intended to return `true` if `x ≤ y` and `false` otherwise. + The specific order relation depends on the model provided for this type. -/ + | cmpLE (x : α) (y : α) : SortOpsCmp α Bool + +/-- +A model of `SortOps` that uses `ℕ` as the type for the cost of operations. In this model, +both comparisons and insertions are counted in a single `ℕ` parameter. + +While this accepts any decidable relation `le`, most sorting algorithms are only well-behaved in the +presence of `[Std.Total le] [IsTrans _ le]`. +-/ +@[simps] +def sortModelNat {α : Type*} + (le : α → α → Prop) [DecidableRel le] : Model (SortOpsCmp α) ℕ where + evalQuery + | .cmpLE x y => decide (le x y) + cost + | .cmpLE _ _ => 1 + +end NatModel + +end Algorithms + +end Cslib diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean new file mode 100644 index 000000000..319807c05 --- /dev/null +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -0,0 +1,150 @@ +/- +Copyright (c) 2025 Tanner Duve. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tanner Duve, Shreyas Srinivas, Eric Wieser +-/ + +module + +public import Mathlib +public import Cslib.Foundations.Control.Monad.Free.Fold +public import Cslib.AlgorithmsTheory.Lean.TimeM + +@[expose] public section + +/- +# Query model + +This file defines a simple query language modeled as a free monad over a +parametric type of query operations. + +## Main definitions + +- `Model Q c`: A model type for a query type `Q : Type u → Type u` and cost type `c` +- `Prog Q α`: The type of programs of query type `Q` and return type `α`. + This is a free monad under the hood +- `Prog.eval`, `Prog.time`: concrete execution semantics of a `Prog Q α` for a given model of `Q` + +## How to set up an algorithm + +This model is a lightweight framework for specifying and verifying both the correctness +and complexity of algorithms in lean. To specify an algorithm, one must: +1. Define an inductive type of queries. This type must at least one index parameter + which determines the output type of the query. Additionally, it helps to have a parameter `α` + on which the index type depends. This way, any instance parameters of `α` can be used easily + for the output types. The signatures of `Model.evalQuery` and `Model.cost` are fixed. + So you can't supply instances for the index type there. +2. Define a record of the `Model Q C` structure that specifies the evaluation and time (cost) of + each query +3. Write your algorithm as a monadic program in `Prog Q α`. With sufficient type anotations + each query `q : Q` is automatically lifted into `Prog Q α`. + +## Tags +query model, free monad, time complexity, Prog +-/ + +namespace Cslib + +namespace Algorithms + +/-- +A model type for a query type `QType` and cost type `Cost`. It consists of +two fields, which respectively define the evaluation and cost of a query. +-/ +structure Model (QType : Type u → Type v) (Cost : Type w) where + /-- Evaluates a query `q : Q ι` to return a result of type `ι`. -/ + evalQuery : QType ι → ι + /-- Counts the operational cost of a query `q : Q ι` to return a result of type `Cost`. + The cost could represent any desired complexity measure, + including but not limited to time complexity. -/ + cost : QType ι → Cost + + +open Cslib.Algorithms.Lean in +/-- lift `Model.cost` to `TimeM Cost ι` -/ +abbrev Model.timeQuery + (M : Model Q Cost) (x : Q ι) : TimeM Cost ι := + TimeM.mk (M.evalQuery x) (M.cost x) + +/-- +A program is defined as a Free Monad over a Query type `Q` which operates on a base type `α` +which can determine the input and output types of a query. +-/ +abbrev Prog Q α := FreeM Q α + +/-- +The evaluation function of a program `P : Prog Q α` given a model `M : Model Q α` of `Q` +-/ +def Prog.eval + (P : Prog Q α) (M : Model Q Cost) : α := + Id.run <| P.liftM fun x => pure (M.evalQuery x) + +@[simp, grind =] +theorem Prog.eval_pure (a : α) (M : Model Q Cost) : + Prog.eval (FreeM.pure a) M = a := + rfl + +@[simp, grind =] +theorem Prog.eval_bind + (x : Prog Q α) (f : α → Prog Q β) (M : Model Q Cost) : + Prog.eval (FreeM.bind x f) M = Prog.eval (f (x.eval M)) M := by + simp [Prog.eval] + +@[simp, grind =] +theorem Prog.eval_liftBind + (x : Q α) (f : α → Prog Q β) (M : Model Q Cost) : + Prog.eval (FreeM.liftBind x f) M = Prog.eval (f <| M.evalQuery x) M := by + simp [Prog.eval] + +/-- +The cost function of a program `P : Prog Q α` given a model `M : Model Q α` of `Q`. +The most common use case of this function is to compute time-complexity, hence the name. + +In practice this is only well-behaved in the presence of `AddCommMonoid Cost`. +-/ +def Prog.time [AddZero Cost] + (P : Prog Q α) (M : Model Q Cost) : Cost := + (P.liftM M.timeQuery).time + +@[simp, grind =] +lemma Prog.time_pure [AddZero Cost] (a : α) (M : Model Q Cost) : + Prog.time (FreeM.pure a) M = 0 := by + simp [time] + +@[simp, grind =] +theorem Prog.time_liftBind [AddZero Cost] + (x : Q α) (f : α → Prog Q β) (M : Model Q Cost) : + Prog.time (FreeM.liftBind x f) M = M.cost x + Prog.time (f <| M.evalQuery x) M := by + simp [Prog.time] + +@[simp, grind =] +lemma Prog.time_bind [AddCommMonoid Cost] (M : Model Q Cost) + (op : Prog Q ι) (cont : ι → Prog Q α) : + Prog.time (op.bind cont) M = + Prog.time op M + Prog.time (cont (Prog.eval op M)) M := by + simp only [eval, time] + induction op with + | pure a => + simp + | liftBind op cont' ih => + specialize ih (M.evalQuery op) + simp_all [add_assoc] + +section Reduction + +/-- A reduction structure from query type `Q₁` to query type `Q₂`. -/ +structure Reduction (Q₁ Q₂ : Type u → Type u) where + /-- `reduce (q : Q₁ α)` is a program `P : Prog Q₂ α` that is intended to + implement `q` in the query type `Q₂` -/ + reduce : Q₁ α → Prog Q₂ α + +/-- +`Prog.reduceProg` takes a reduction structure from a query `Q₁` to `Q₂` and extends its +`reduce` function to programs on the query type `Q₁`. +-/ +abbrev Prog.reduceProg (P : Prog Q₁ α) (red : Reduction Q₁ Q₂) : Prog Q₂ α := + P.liftM red.reduce + +end Reduction + +end Cslib.Algorithms diff --git a/Cslib/Foundations/Control/Monad/Free.lean b/Cslib/Foundations/Control/Monad/Free.lean index 9cf40c322..d27476d40 100644 --- a/Cslib/Foundations/Control/Monad/Free.lean +++ b/Cslib/Foundations/Control/Monad/Free.lean @@ -96,7 +96,7 @@ variable {F : Type u → Type v} {ι : Type u} {α : Type w} {β : Type w'} {γ instance : Pure (FreeM F) where pure := .pure -@[simp] +@[simp, grind =] theorem pure_eq_pure : (pure : α → FreeM F α) = FreeM.pure := rfl /-- Bind operation for the `FreeM` monad. -/ @@ -115,7 +115,7 @@ protected theorem bind_assoc (x : FreeM F α) (f : α → FreeM F β) (g : β instance : Bind (FreeM F) where bind := .bind -@[simp] +@[simp, grind =] theorem bind_eq_bind {α β : Type w} : Bind.bind = (FreeM.bind : FreeM F α → _ → FreeM F β) := rfl /-- Map a function over a `FreeM` monad. -/ @@ -154,14 +154,21 @@ lemma map_lift (f : ι → α) (op : F ι) : map f (lift op : FreeM F ι) = liftBind op (fun z => (.pure (f z) : FreeM F α)) := rfl /-- `.pure a` followed by `bind` collapses immediately. -/ -@[simp] +@[simp, grind =] lemma pure_bind (a : α) (f : α → FreeM F β) : (.pure a : FreeM F α).bind f = f a := rfl -@[simp] +@[simp, grind =] +lemma pure_bind' {α β} (a : α) (f : α → FreeM F β) : (.pure a : FreeM F α) >>= f = f a := + pure_bind a f + +@[simp, grind =] lemma bind_pure : ∀ x : FreeM F α, x.bind (.pure) = x | .pure a => rfl | liftBind op k => by simp [FreeM.bind, bind_pure] +@[simp, grind =] +lemma bind_pure' : ∀ x : FreeM F α, x >>= .pure = x := bind_pure + @[simp] lemma bind_pure_comp (f : α → β) : ∀ x : FreeM F α, x.bind (.pure ∘ f) = map f x | .pure a => rfl @@ -223,6 +230,9 @@ lemma liftM_bind [LawfulMonad m] rw [FreeM.bind, liftM_liftBind, liftM_liftBind, bind_assoc] simp_rw [ih] +instance {Q α} : CoeOut (Q α) (FreeM Q α) where + coe := FreeM.lift + /-- A predicate stating that `interp : FreeM F α → m α` is an interpreter for the effect handler `handler : ∀ {α}, F α → m α`. diff --git a/CslibTests.lean b/CslibTests.lean index 73292aef3..c1c44021a 100644 --- a/CslibTests.lean +++ b/CslibTests.lean @@ -11,4 +11,6 @@ public import CslibTests.HasFresh public import CslibTests.ImportWithMathlib public import CslibTests.LTS public import CslibTests.LambdaCalculus +public import CslibTests.QueryModel.ProgExamples +public import CslibTests.QueryModel.QueryExamples public import CslibTests.Reduction diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean new file mode 100644 index 000000000..18c70e985 --- /dev/null +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2025 Shreyas Srinivas. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Shreyas Srinivas +-/ + +module + +public import Cslib.AlgorithmsTheory.QueryModel + +@[expose] public section + +namespace Cslib + +namespace Algorithms + +namespace Prog + +section ProgExamples + +inductive Arith (α : Type u) : Type u → Type _ where + | add (x y : α) : Arith α α + | mul (x y : α) : Arith α α + | neg (x : α) : Arith α α + | zero : Arith α α + | one : Arith α α + +def Arith.natCost [Ring α] : Model (Arith α) ℕ where + evalQuery + | .add x y => x + y + | .mul x y => x * y + | .neg x => -x + | .zero => 0 + | .one => 1 + cost _ := 1 + +open Arith in +def ex1 : Prog (Arith α) α := do + let mut x : α ← @zero α + let mut y ← @one α + let z ← (add x y) + let w ← @neg α (← add z y) + add w z + +/-- The array version of the sort operations. -/ +inductive VecSortOps.{u} (α : Type u) : Type u → Type _ where + | swap (a : Vector α n) (i j : Fin n) : VecSortOps α (Vector α n) + -- Note that we have to ULift the result to fit this in the same universe as the other types. + -- We can avoid this only by forcing everything to be in `Type 0`. + | cmp (a : Vector α n) (i j : Fin n) : VecSortOps α (ULift Bool) + | write (a : Vector α n) (i : Fin n) (x : α) : VecSortOps α (Vector α n) + | read (a : Vector α n) (i : Fin n) : VecSortOps α α + | push (a : Vector α n) (elem : α) : VecSortOps α (Vector α (n + 1)) + +/-- The typical means of evaluating a `VecSortOps`. -/ +@[simp] +def VecSortOps.eval [BEq α] : VecSortOps α β → β + | .write v i x => v.set i x + | .cmp l i j => .up <| l[i] == l[j] + | .read l i => l[i] + | .swap l i j => l.swap i j + | .push a elem => a.push elem + +@[simps] +def VecSortOps.worstCase [DecidableEq α] : Model (VecSortOps α) ℕ where + evalQuery := VecSortOps.eval + cost + | .write _ _ _ => 1 + | .read _ _ => 1 + | .cmp _ _ _ => 1 + | .swap _ _ _ => 1 + | .push _ _ => 2 -- amortized over array insertion and resizing by doubling + +@[simps] +def VecSortOps.cmpSwap [DecidableEq α] : Model (VecSortOps α) ℕ where + evalQuery := VecSortOps.eval + cost + | .cmp _ _ _ => 1 + | .swap _ _ _ => 1 + | _ => 0 + +open VecSortOps in +def simpleExample (v : Vector ℤ n) (i k : Fin n) : + Prog (VecSortOps ℤ) (Vector ℤ (n + 1)) := do + let b : Vector ℤ n ← write v i 10 + let mut c : Vector ℤ n ← swap b i k + let elem ← read c i + push c elem + +inductive VecSearch (α : Type u) : Type → Type _ where + | compare (a : Vector α n) (i : ℕ) (val : α) : VecSearch α Bool + +@[simps] +def VecSearch.nat [DecidableEq α] : Model (VecSearch α) ℕ where + evalQuery + | .compare l i x => l[i]? == some x + cost + | .compare _ _ _ => 1 + +open VecSearch in +def linearSearchAux (v : Vector α n) + (x : α) (acc : Bool) (index : ℕ) : Prog (VecSearch α) Bool := do + if h : index ≥ n then + return acc + else + let cmp_res : Bool ← compare v index x + if cmp_res then + return true + else + linearSearchAux v x false (index + 1) + +open VecSearch in +def linearSearch (v : Vector α n) (x : α) : Prog (VecSearch α) Bool:= + linearSearchAux v x false 0 + +end ProgExamples + +end Prog + +end Algorithms + +end Cslib diff --git a/CslibTests/QueryModel/QueryExamples.lean b/CslibTests/QueryModel/QueryExamples.lean new file mode 100644 index 000000000..6d9b11c41 --- /dev/null +++ b/CslibTests/QueryModel/QueryExamples.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2025 Shreyas Srinivas. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Shreyas Srinivas +-/ + +module + +public import Cslib.AlgorithmsTheory.QueryModel + + +@[expose] public section + +namespace Cslib + +namespace Algorithms + +section Examples + +/-- +ListOps provides an example of list query type equipped with a `find` query. +The complexity of this query depends on the search algorithm used. This means +we can define two separate models for modelling situations where linear search +or binary search is used. +-/ +inductive ListOps (α : Type u) : Type u → Type _ where + | get (l : List α) (i : Fin l.length) : ListOps α α + | find (l : List α) (elem : α) : ListOps α (ULift ℕ) + | write (l : List α) (i : Fin l.length) (x : α) : ListOps α (List α) + +/-- The typical means of evaluating a `ListOps`. -/ +@[simp] +def ListOps.eval [BEq α] : ListOps α ι → ι + | .write l i x => l.set i x + | .find l elem => l.findIdx (· == elem) + | .get l i => l[i] + +@[simps] +def ListOps.linSearchWorstCase [DecidableEq α] : Model (ListOps α) ℕ where + evalQuery := ListOps.eval + cost + | .write l _ _ => l.length + | .find l _ => l.length + | .get l _ => l.length + +def ListOps.binSearchWorstCase [BEq α] : Model (ListOps α) ℕ where + evalQuery := ListOps.eval + cost + | .find l _ => 1 + Nat.log 2 (l.length) + | .write l _ _ => l.length + | .get l _ => l.length + +inductive ArrayOps (α : Type u) : Type u → Type _ where + | get (l : Array α) (i : Fin l.size) : ArrayOps α α + | find (l : Array α) (x : α) : ArrayOps α (ULift ℕ) + | write (l : Array α) (i : Fin l.size) (x : α) : ArrayOps α (Array α) + +/-- The typical means of evaluating a `ListOps`. -/ +@[simp] +def ArrayOps.eval [BEq α] : ArrayOps α ι → ι + | .write l i x => l.set i x + | .find l elem => l.findIdx (· == elem) + | .get l i => l[i] + +@[simps] +def ArrayOps.binSearchWorstCase [BEq α] : Model (ArrayOps α) ℕ where + evalQuery := ArrayOps.eval + cost + | .find l _ => 1 + Nat.log 2 (l.size) + | .write _ _ _ => 1 + | .get _ _ => 1 + +end Examples + +end Algorithms + +end Cslib From e50c8b000a7a44fb6d7fc5f226fadcc674ea70a0 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 27 Feb 2026 00:41:31 +0100 Subject: [PATCH 02/75] Fixed worst case statement --- .../Algorithms/ListInsertionSort.lean | 3 +- .../Algorithms/ListLinearSearch.lean | 31 ++++++++++++++----- .../Algorithms/ListOrderedInsert.lean | 5 ++- .../Algorithms/MergeSort.lean | 1 - .../Models/ListComparisonSearch.lean | 1 - .../Models/ListComparisonSort.lean | 6 +++- Cslib/AlgorithmsTheory/QueryModel.lean | 1 - 7 files changed, 34 insertions(+), 14 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index 86c85c3ee..5b83202b2 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -5,9 +5,7 @@ Authors: Shreyas Srinivas, Eric Wieser -/ module -public import Cslib.AlgorithmsTheory.QueryModel public import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert -public import Mathlib @[expose] public section @@ -98,3 +96,4 @@ theorem insertionSort_complexity (l : List α) (le : α → α → Prop) [Decida end Algorithms end Cslib +#min_imports diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index 0a1f5c3a9..3e68c9347 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -8,7 +8,10 @@ module public import Cslib.AlgorithmsTheory.QueryModel public import Cslib.AlgorithmsTheory.Models.ListComparisonSearch -public import Mathlib +public import Mathlib.Algebra.Order.Group.Nat +public import Mathlib.Data.Int.ConditionallyCompleteOrder +public import Mathlib.Order.ConditionallyCompleteLattice.Basic +public import Mathlib.Tactic.Set @[expose] public section @@ -71,12 +74,26 @@ lemma listLinearSearchM_time_complexity_upper_bound [BEq α] (l : List α) (x : simp_all [listLinearSearch] grind --- This statement is wrong -lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [Nonempty α] : - ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch.natCost = l.length := by - inhabit α - refine ⟨[], default, ?_⟩ - simp_all [ListSearch.natCost, listLinearSearch] +lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [Nontrivial α] : + ∀ n, ∃ l : List α, ∃ x : α, l.length = n + ∧ (listLinearSearch l x).time ListSearch.natCost = l.length := by + intro n + obtain ⟨x, y, hneq⟩ := exists_pair_ne α + use (List.replicate n y), x + refine ⟨?_, ?_⟩ + · simp + · induction n with + | zero => simp [listLinearSearch, List.replicate] + | succ m ih => + simp only [List.replicate, listLinearSearch, FreeM.lift_def, FreeM.pure_eq_pure, + FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, time_liftBind, + ListSearch.natCost_cost, ListSearch.natCost_evalQuery, List.head?_cons, + Option.some_beq_some, beq_iff_eq, List.length_cons, List.length_replicate] + split_ifs with hxy_eq + · exfalso + tauto + · rw [ih, List.length_replicate, add_comm] + end Algorithms diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 4a0ebfb93..10a2ef7ef 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -8,7 +8,10 @@ module public import Cslib.AlgorithmsTheory.QueryModel public import Cslib.AlgorithmsTheory.Models.ListComparisonSort -public import Mathlib +public import Mathlib.Algebra.Order.Group.Nat +public import Mathlib.Data.Int.ConditionallyCompleteOrder +public import Mathlib.Data.List.Sort +public import Mathlib.Order.ConditionallyCompleteLattice.Basic @[expose] public section diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index a2a235984..66c6d3f3e 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -6,7 +6,6 @@ Authors: Shreyas Srinivas, Eric Wieser module -public import Cslib.AlgorithmsTheory.QueryModel public import Cslib.AlgorithmsTheory.Models.ListComparisonSort public import Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort import all Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean index 888f223bc..1e5d331fc 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean @@ -7,7 +7,6 @@ Authors: Shreyas Srinivas module public import Cslib.AlgorithmsTheory.QueryModel -public import Mathlib @[expose] public section diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 5aad6b123..5fe1ab958 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -7,7 +7,11 @@ Authors: Shreyas Srinivas, Eric WIeser module public import Cslib.AlgorithmsTheory.QueryModel - +public import Mathlib.Algebra.Group.Nat.Defs +public import Mathlib.Algebra.Group.Prod +public import Mathlib.Data.Nat.Basic +public import Mathlib.Order.Basic +public import Mathlib.Tactic.FastInstance @[expose] public section /-! diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 319807c05..d3f1fd877 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -6,7 +6,6 @@ Authors: Tanner Duve, Shreyas Srinivas, Eric Wieser module -public import Mathlib public import Cslib.Foundations.Control.Monad.Free.Fold public import Cslib.AlgorithmsTheory.Lean.TimeM From 79d77de65b11f336945f15d248babe419622d0f9 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 27 Feb 2026 00:42:58 +0100 Subject: [PATCH 03/75] Linarith --- Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index 5b83202b2..c9dde2880 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -6,6 +6,7 @@ Authors: Shreyas Srinivas, Eric Wieser module public import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert +public import Mathlib.Tactic.Linarith @[expose] public section From c1e3323ae4e17bcd7a8e3fc1d93dcef5eac7b933 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 27 Feb 2026 00:46:02 +0100 Subject: [PATCH 04/75] More review fixes --- .../Algorithms/ListOrderedInsert.lean | 2 +- .../Algorithms/MergeSort.lean | 29 ++++--------------- .../Models/ListComparisonSort.lean | 3 +- 3 files changed, 7 insertions(+), 27 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 10a2ef7ef..1b93f08a2 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -68,7 +68,7 @@ lemma insertOrd_eval (x : α) (l : List α) (le : α → α → Prop) [Decidable · simp [insertOrd, h_head] · simp [insertOrd, h_head, ih] --- to upstream +-- TODO : to upstream @[simp] lemma _root_.List.length_orderedInsert (x : α) (l : List α) [DecidableRel r] : (l.orderedInsert r x).length = l.length + 1 := by diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 66c6d3f3e..cd17e2165 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -123,7 +123,6 @@ private lemma mergeSort_eval (xs : List α) (le : α → α → Prop) [Decidable simp [h, mergeSortNaive, Prog.eval] | case2 xs h n left right ihl ihr => rw [mergeSortNaive, if_neg h] - have im := merge_eval left right simp [ihl, ihr, merge_eval] rfl @@ -177,29 +176,11 @@ open Cslib.Algorithms.Lean.TimeM -- TODO: reuse the work in `mergeSort_time_le`? theorem mergeSort_complexity (xs : List α) (le : α → α → Prop) [DecidableRel le] : (mergeSort xs).time (sortModelNat le) ≤ T (xs.length) := by - fun_induction mergeSort - · simp [T] - · expose_names - simp only [FreeM.bind_eq_bind, Prog.time_bind, mergeSort_eval] - grw [merge_timeComplexity, ih1, ih2, mergeSortNaive_length, mergeSortNaive_length] - set n := x.length - have hleft_len : left.length ≤ n / 2 := by - grind - have hright_len : right.length ≤ (n + 1) / 2 := by - have hright_eq : right.length = n - n / 2 := by - simp [right, n, half, List.length_drop] - rw [hright_eq] - grind - have htleft_len : T left.length ≤ T (n / 2) := T_monotone hleft_len - have htright_len : T right.length ≤ T ((n + 1) / 2) := T_monotone hright_len - grw [htleft_len, htright_len, hleft_len, hright_len] - have hs := some_algebra (n - 2) - have hsub1 : (n - 2) / 2 + 1 = n / 2 := by grind - have hsub2 : 1 + (1 + (n - 2)) / 2 = (n + 1) / 2 := by grind - have hsub3 : (n - 2) + 2 = n := by grind - have hsplit : n / 2 + (n + 1) / 2 = n := by grind - simpa [T, hsub1, hsub2, hsub3, hsplit, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] - using hs + fun_induction mergeSort with + | case1 => simp [T] + | case2 x => + simp only [FreeM.bind_eq_bind, Prog.time_bind] + grind [some_algebra (x.length - 2), mergeSort_eval, merge_timeComplexity, mergeSortNaive_length] end TimeComplexity diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 5fe1ab958..3b03b62c8 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -140,8 +140,7 @@ def sortModelNat {α : Type*} (le : α → α → Prop) [DecidableRel le] : Model (SortOpsCmp α) ℕ where evalQuery | .cmpLE x y => decide (le x y) - cost - | .cmpLE _ _ => 1 + cost _ := 1 end NatModel From ddab6f0d29b202ef4bc3296c933b9e7d79f0281a Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 27 Feb 2026 00:47:28 +0100 Subject: [PATCH 05/75] More review fixes --- Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 1b93f08a2..a945ba351 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -89,7 +89,7 @@ theorem insertOrd_complexity_upper_bound grind lemma insertOrd_sorted - (l : List α) (x : α) (le : α → α → Prop) [DecidableRel le] [Std.Total le] [IsTrans _ le] : + (l : List α) (x : α) (le : α → α → Prop) [DecidableRel le] [Std.Total le] [IsTrans α le] : l.Pairwise le → ((insertOrd x l).eval (sortModel le)).Pairwise le := by rw [insertOrd_eval] exact List.Pairwise.orderedInsert _ _ From 08decfa3faf8f6b90d4b2f11c9125fdba329271c Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 27 Feb 2026 00:48:51 +0100 Subject: [PATCH 06/75] More review fixes --- .../Algorithms/ListInsertionSort.lean | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index c9dde2880..c65266d23 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -83,18 +83,9 @@ theorem insertionSort_complexity (l : List α) (le : α → α → Prop) [Decida simp [insertionSort] | cons head tail ih => have h := insertOrd_complexity_upper_bound (tail.insertionSort le) head le - simp_all only [List.length_cons, List.length_insertionSort] - obtain ⟨ih₁,ih₂⟩ := ih - obtain ⟨h₁,h₂⟩ := h - refine ⟨?_, ?_⟩ - · clear h₂ - rw [insertionSort_time_compares] - nlinarith [ih₁, h₁] - · clear h₁ - rw [insertionSort_time_inserts] - nlinarith [ih₂, h₂] + grind [insertOrd_complexity_upper_bound, List.length_insertionSort, SortOpsCost.le_def, + insertionSort_time_compares, insertionSort_time_inserts] end Algorithms end Cslib -#min_imports From a2b47823891c31996a47dc22f553fdfaf7b6ebe5 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 27 Feb 2026 00:49:17 +0100 Subject: [PATCH 07/75] More review fixes --- Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean | 1 - 1 file changed, 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index c65266d23..833acf434 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -82,7 +82,6 @@ theorem insertionSort_complexity (l : List α) (le : α → α → Prop) [Decida | nil => simp [insertionSort] | cons head tail ih => - have h := insertOrd_complexity_upper_bound (tail.insertionSort le) head le grind [insertOrd_complexity_upper_bound, List.length_insertionSort, SortOpsCost.le_def, insertionSort_time_compares, insertionSort_time_inserts] From 54bb3516081ef420ed0137c3502b51199e5bd8aa Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 27 Feb 2026 00:50:29 +0100 Subject: [PATCH 08/75] More review fixes --- Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index 3e68c9347..2ef207651 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -72,7 +72,7 @@ lemma listLinearSearchM_time_complexity_upper_bound [BEq α] (l : List α) (x : | case2 => simp_all [listLinearSearch] | case3 => simp_all [listLinearSearch] - grind + lia lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [Nontrivial α] : ∀ n, ∃ l : List α, ∃ x : α, l.length = n From 7ee16a0054ee73e4e2561b4fd32efc49d65448f5 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 27 Feb 2026 00:51:26 +0100 Subject: [PATCH 09/75] More review fixes --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index cd17e2165..cda6f2a77 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -66,13 +66,7 @@ lemma merge_timeComplexity (x y : List α) (le : α → α → Prop) [DecidableR @[simp] lemma merge_eval (x y : List α) (le : α → α → Prop) [DecidableRel le] : (merge x y).eval (sortModelNat le) = List.merge x y (le · ·) := by - fun_induction List.merge with - | case1 => simp - | case2 => simp - | case3 x xs y ys ihx ihy => simp_all [merge] - | case4 x xs y ys hxy ihx => - rw [decide_eq_true_iff] at hxy - simp_all [merge, -not_le] + fun_induction List.merge with simp_all [merge] lemma merge_length (x y : List α) (le : α → α → Prop) [DecidableRel le] : ((merge x y).eval (sortModelNat le)).length = x.length + y.length := by From cc806f04180aa5f5b1dd5717bb85eba7e36656c1 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 27 Feb 2026 00:52:42 +0100 Subject: [PATCH 10/75] More review fixes --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index cda6f2a77..41d7b68e3 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -103,11 +103,9 @@ private proof_wanted mergeSortNaive_eq_mergeSort private lemma mergeSortNaive_Perm (xs : List α) (le : α → α → Prop) [DecidableRel le] : (mergeSortNaive xs le).Perm xs := by - fun_induction mergeSortNaive - · simp - · expose_names - rw [←(List.take_append_drop (x.length / 2) x)] - grw [List.merge_perm_append, ← ih1, ← ih2] + fun_induction mergeSortNaive with + | case1 => simp + | case2 x _ _ _ ih2 ih1 => grw [←List.take_append_drop _ x, List.merge_perm_append, ← ih1, ← ih2] @[simp] private lemma mergeSort_eval (xs : List α) (le : α → α → Prop) [DecidableRel le] : From a732ed819e2e390475c87d315b35e9dcaa9f2d76 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 27 Feb 2026 00:57:57 +0100 Subject: [PATCH 11/75] Fix test file imports --- CslibTests/QueryModel/ProgExamples.lean | 1 + CslibTests/QueryModel/QueryExamples.lean | 4 +++- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean index 18c70e985..d993c7037 100644 --- a/CslibTests/QueryModel/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -7,6 +7,7 @@ Authors: Shreyas Srinivas module public import Cslib.AlgorithmsTheory.QueryModel +public import Mathlib.Algebra.Lie.OfAssociative @[expose] public section diff --git a/CslibTests/QueryModel/QueryExamples.lean b/CslibTests/QueryModel/QueryExamples.lean index 6d9b11c41..ce04b4067 100644 --- a/CslibTests/QueryModel/QueryExamples.lean +++ b/CslibTests/QueryModel/QueryExamples.lean @@ -7,7 +7,9 @@ Authors: Shreyas Srinivas module public import Cslib.AlgorithmsTheory.QueryModel - +public import Cslib.AlgorithmsTheory.QueryModel +public import Mathlib.Algebra.Ring.ULift +public import Mathlib.Data.Nat.Log @[expose] public section From 2cee489bf823980575b876e053c61c4ec06b2667 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 27 Feb 2026 00:59:16 +0100 Subject: [PATCH 12/75] More review fixes --- Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean index 1e5d331fc..4badcfa2b 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean @@ -45,8 +45,7 @@ inductive ListSearch (α : Type*) : Type → Type _ where def ListSearch.natCost [BEq α] : Model (ListSearch α) ℕ where evalQuery | .compare l x => some x == l.head? - cost - | .compare _ _ => 1 + cost _ := 1 end Algorithms From 3e7edf2f31f8d15672bf95b99fccc2fbfb11e557 Mon Sep 17 00:00:00 2001 From: Chris Henson Date: Thu, 26 Feb 2026 23:23:36 -0500 Subject: [PATCH 13/75] small golfs --- .../Algorithms/ListLinearSearch.lean | 25 ++++++------------- 1 file changed, 7 insertions(+), 18 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index 2ef207651..542502f09 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -71,29 +71,18 @@ lemma listLinearSearchM_time_complexity_upper_bound [BEq α] (l : List α) (x : | case1 => simp [listLinearSearch] | case2 => simp_all [listLinearSearch] | case3 => - simp_all [listLinearSearch] + simp [listLinearSearch] lia -lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [Nontrivial α] : - ∀ n, ∃ l : List α, ∃ x : α, l.length = n +lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [Nontrivial α] (n : ℕ) : + ∃ (l : List α) (x : α), l.length = n ∧ (listLinearSearch l x).time ListSearch.natCost = l.length := by - intro n obtain ⟨x, y, hneq⟩ := exists_pair_ne α - use (List.replicate n y), x - refine ⟨?_, ?_⟩ + use List.replicate n y, x + split_ands · simp - · induction n with - | zero => simp [listLinearSearch, List.replicate] - | succ m ih => - simp only [List.replicate, listLinearSearch, FreeM.lift_def, FreeM.pure_eq_pure, - FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, time_liftBind, - ListSearch.natCost_cost, ListSearch.natCost_evalQuery, List.head?_cons, - Option.some_beq_some, beq_iff_eq, List.length_cons, List.length_replicate] - split_ifs with hxy_eq - · exfalso - tauto - · rw [ih, List.length_replicate, add_comm] - + · induction n <;> simp [listLinearSearch, List.replicate] + grind [ListSearch.natCost_cost, ListSearch.natCost_evalQuery] end Algorithms From 47896398f0e0449fdf64ca2438e5a75c451a9ea7 Mon Sep 17 00:00:00 2001 From: Shrys Date: Fri, 27 Feb 2026 08:37:28 +0100 Subject: [PATCH 14/75] Update CslibTests/QueryModel/ProgExamples.lean Co-authored-by: Eric Wieser --- CslibTests/QueryModel/ProgExamples.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean index d993c7037..4982703a4 100644 --- a/CslibTests/QueryModel/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -67,7 +67,7 @@ def VecSortOps.worstCase [DecidableEq α] : Model (VecSortOps α) ℕ where evalQuery := VecSortOps.eval cost | .write _ _ _ => 1 - | .read _ _ => 1 + | .read _ _ => 1 | .cmp _ _ _ => 1 | .swap _ _ _ => 1 | .push _ _ => 2 -- amortized over array insertion and resizing by doubling From afcfd5757dd628d6a50940da1eb97acf98610a84 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 27 Feb 2026 08:51:23 +0100 Subject: [PATCH 15/75] Add docstrings for test files --- CslibTests/QueryModel/ProgExamples.lean | 10 ++++ CslibTests/QueryModel/QueryExamples.lean | 61 +++++++++++++++++------- 2 files changed, 54 insertions(+), 17 deletions(-) diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean index d993c7037..80d1e99cb 100644 --- a/CslibTests/QueryModel/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -11,6 +11,16 @@ public import Mathlib.Algebra.Lie.OfAssociative @[expose] public section +/-! +# Additional examples of Progs with Query Types + +This file contains two query types and associated `Prog`s +- `Arith` with `ex1` +- `VectorSortOps` with `simpleExample` +- `VecSearch` with `linearSearch` +They are meant to be additional examples to guide authors to write +query types and programs on top of them +-/ namespace Cslib namespace Algorithms diff --git a/CslibTests/QueryModel/QueryExamples.lean b/CslibTests/QueryModel/QueryExamples.lean index ce04b4067..26c8092e6 100644 --- a/CslibTests/QueryModel/QueryExamples.lean +++ b/CslibTests/QueryModel/QueryExamples.lean @@ -13,6 +13,16 @@ public import Mathlib.Data.Nat.Log @[expose] public section +/-! +# Additional examples of Query Types + +This file contains two query types +- `ListOpsWithFind` +- `ArrayOpsWithFind` +which respectively provide query types for List and Array operations +equipped with a searching algorithm, and different models for them. +They are meant to be additional examples to guide authors of query types +-/ namespace Cslib namespace Algorithms @@ -20,53 +30,70 @@ namespace Algorithms section Examples /-- -ListOps provides an example of list query type equipped with a `find` query. +ListOpsWithFind provides an example of list query type equipped with a `find` query. The complexity of this query depends on the search algorithm used. This means we can define two separate models for modelling situations where linear search or binary search is used. -/ -inductive ListOps (α : Type u) : Type u → Type _ where - | get (l : List α) (i : Fin l.length) : ListOps α α - | find (l : List α) (elem : α) : ListOps α (ULift ℕ) - | write (l : List α) (i : Fin l.length) (x : α) : ListOps α (List α) +inductive ListOpsWithFind (α : Type u) : Type u → Type _ where + | get (l : List α) (i : Fin l.length) : ListOpsWithFind α α + | find (l : List α) (elem : α) : ListOpsWithFind α (ULift ℕ) + | write (l : List α) (i : Fin l.length) (x : α) : ListOpsWithFind α (List α) /-- The typical means of evaluating a `ListOps`. -/ @[simp] -def ListOps.eval [BEq α] : ListOps α ι → ι +def ListOpsWithFind.eval [BEq α] : ListOpsWithFind α ι → ι | .write l i x => l.set i x | .find l elem => l.findIdx (· == elem) | .get l i => l[i] +/-- +A model of `ListOpsWithFind` that assumes that `find` is implemented by a +linear search like `Θ(n)` algorithm. +-/ @[simps] -def ListOps.linSearchWorstCase [DecidableEq α] : Model (ListOps α) ℕ where - evalQuery := ListOps.eval +def ListOpsWithFind.linSearchWorstCase [DecidableEq α] : Model (ListOpsWithFind α) ℕ where + evalQuery := ListOpsWithFind.eval cost | .write l _ _ => l.length | .find l _ => l.length | .get l _ => l.length -def ListOps.binSearchWorstCase [BEq α] : Model (ListOps α) ℕ where - evalQuery := ListOps.eval +/-- +A model of `ListOpsWithFind` that assumes that `find` is implemented by a +binary-search like `Θ(log n)` algorithm. +-/ +def ListOps.binSearchWorstCase [BEq α] : Model (ListOpsWithFind α) ℕ where + evalQuery := ListOpsWithFind.eval cost | .find l _ => 1 + Nat.log 2 (l.length) | .write l _ _ => l.length | .get l _ => l.length -inductive ArrayOps (α : Type u) : Type u → Type _ where - | get (l : Array α) (i : Fin l.size) : ArrayOps α α - | find (l : Array α) (x : α) : ArrayOps α (ULift ℕ) - | write (l : Array α) (i : Fin l.size) (x : α) : ArrayOps α (Array α) +/-- +ArrayOpsWithFind is the `Array` version of `ListOpsWithFind`. It comes with +`get` and `write` queries, and additionally a `find` query which corresponds +to a search algorithm. +-/ +inductive ArrayOpsWithFind (α : Type u) : Type u → Type _ where + | get (l : Array α) (i : Fin l.size) : ArrayOpsWithFind α α + | find (l : Array α) (x : α) : ArrayOpsWithFind α (ULift ℕ) + | write (l : Array α) (i : Fin l.size) (x : α) : ArrayOpsWithFind α (Array α) /-- The typical means of evaluating a `ListOps`. -/ @[simp] -def ArrayOps.eval [BEq α] : ArrayOps α ι → ι +def ArrayOpsWithFind.eval [BEq α] : ArrayOpsWithFind α ι → ι | .write l i x => l.set i x | .find l elem => l.findIdx (· == elem) | .get l i => l[i] +/-- +A model of `ArrayOpsWithFind` that assumes that `find` is implemented by a +binary-search like `Θ(log n)` algorithm. +-/ @[simps] -def ArrayOps.binSearchWorstCase [BEq α] : Model (ArrayOps α) ℕ where - evalQuery := ArrayOps.eval +def ArrayOpsWithFind.binSearchWorstCase [BEq α] : Model (ArrayOpsWithFind α) ℕ where + evalQuery := ArrayOpsWithFind.eval cost | .find l _ => 1 + Nat.log 2 (l.size) | .write _ _ _ => 1 From 4e3d80cccdee830b0e0d29ab3bc3ab3f6e6ee6a1 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 27 Feb 2026 09:18:07 +0100 Subject: [PATCH 16/75] simps in a tutorial example --- CslibTests/QueryModel/QueryExamples.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/CslibTests/QueryModel/QueryExamples.lean b/CslibTests/QueryModel/QueryExamples.lean index 26c8092e6..b4134bed1 100644 --- a/CslibTests/QueryModel/QueryExamples.lean +++ b/CslibTests/QueryModel/QueryExamples.lean @@ -63,6 +63,7 @@ def ListOpsWithFind.linSearchWorstCase [DecidableEq α] : Model (ListOpsWithFind A model of `ListOpsWithFind` that assumes that `find` is implemented by a binary-search like `Θ(log n)` algorithm. -/ +@[simps] def ListOps.binSearchWorstCase [BEq α] : Model (ListOpsWithFind α) ℕ where evalQuery := ListOpsWithFind.eval cost From 9f3df4d91e993352739655fafc8a6076fb410069 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 27 Feb 2026 18:15:36 +0100 Subject: [PATCH 17/75] Suggested name change. Additionally add co-author list: Co-authored-by: Shreyas Srinivas Co-authored-by: Eric Wieser Co-authored-by: Tanner Duve --- .../Algorithms/ListInsertionSort.lean | 6 +++--- .../Algorithms/ListOrderedInsert.lean | 4 ++-- .../AlgorithmsTheory/Algorithms/MergeSort.lean | 6 +++--- .../Models/ListComparisonSort.lean | 17 +++++++++-------- 4 files changed, 17 insertions(+), 16 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index 833acf434..e0e9ce675 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -14,13 +14,13 @@ public import Mathlib.Tactic.Linarith # Insertion sort in a list In this file we state and prove the correctness and complexity of insertion sort in lists under -the `SortOps` model. This insertionSort evaluates identically to the upstream version of +the `SortOpsInsertHead` model. This insertionSort evaluates identically to the upstream version of `List.insertionSort` -- ## Main Definitions -- `insertionSort` : Insertion sort algorithm in the `SortOps` query model +- `insertionSort` : Insertion sort algorithm in the `SortOpsInsertHead` query model ## Main results @@ -38,7 +38,7 @@ namespace Algorithms open Prog /-- The insertionSort algorithms on lists with the `SortOps` query. -/ -def insertionSort (l : List α) : Prog (SortOps α) (List α) := +def insertionSort (l : List α) : Prog (SortOpsInsertHead α) (List α) := match l with | [] => return [] | x :: xs => do diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index a945ba351..5a99a59ac 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -41,13 +41,13 @@ namespace Algorithms open Prog -open SortOps +open SortOpsInsertHead /-- Performs ordered insertion of `x` into a list `l` in the `SortOps` query model. If `l` is sorted, then `x` is inserted into `l` such that the resultant list is also sorted. -/ -def insertOrd (x : α) (l : List α) : Prog (SortOps α) (List α) := do +def insertOrd (x : α) (l : List α) : Prog (SortOpsInsertHead α) (List α) := do match l with | [] => insertHead x l | a :: as => diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 41d7b68e3..a96e1d2ad 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -32,11 +32,11 @@ the `SortOps` model. -/ namespace Cslib.Algorithms -open SortOpsCmp +open SortOps /-- Merge two sorted lists using comparisons in the query monad. -/ @[simp] -def merge (x y : List α) : Prog (SortOpsCmp α) (List α) := do +def merge (x y : List α) : Prog (SortOps α) (List α) := do match x,y with | [], ys => return ys | xs, [] => return xs @@ -77,7 +77,7 @@ lemma merge_length (x y : List α) (le : α → α → Prop) [DecidableRel le] : The `mergeSort` algorithm in the `SortOps` query model. It sorts the input list according to the mergeSort algorithm. -/ -def mergeSort (xs : List α) : Prog (SortOpsCmp α) (List α) := do +def mergeSort (xs : List α) : Prog (SortOps α) (List α) := do if xs.length < 2 then return xs else let half := xs.length / 2 diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 3b03b62c8..939491df9 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -41,14 +41,14 @@ open Prog /-- A model for comparison sorting on lists. -/ -inductive SortOps (α : Type) : Type → Type where +inductive SortOpsInsertHead (α : Type) : Type → Type where /-- `cmpLE x y` is intended to return `true` if `x ≤ y` and `false` otherwise. The specific order relation depends on the model provided for this typ. e-/ - | cmpLE (x : α) (y : α) : SortOps α Bool + | cmpLE (x : α) (y : α) : SortOpsInsertHead α Bool /-- `insertHead l x` is intended to return `x :: l`. -/ - | insertHead (x : α) (l : List α) : SortOps α (List α) + | insertHead (x : α) (l : List α) : SortOpsInsertHead α (List α) -open SortOps +open SortOpsInsertHead section SortOpsCostModel @@ -107,7 +107,8 @@ While this accepts any decidable relation `le`, most sorting algorithms are only presence of `[Std.Total le] [IsTrans _ le]`. -/ @[simps, grind] -def sortModel {α : Type} (le : α → α → Prop) [DecidableRel le] : Model (SortOps α) SortOpsCost where +def sortModel {α : Type} (le : α → α → Prop) [DecidableRel le] : + Model (SortOpsInsertHead α) SortOpsCost where evalQuery | .cmpLE x y => decide (le x y) | .insertHead x l => x :: l @@ -123,10 +124,10 @@ section NatModel A model for comparison sorting on lists with only the comparison operation. This is used in mergeSort. -/ -inductive SortOpsCmp.{u} (α : Type u) : Type → Type _ where +inductive SortOps.{u} (α : Type u) : Type → Type _ where /-- `cmpLE x y` is intended to return `true` if `x ≤ y` and `false` otherwise. The specific order relation depends on the model provided for this type. -/ - | cmpLE (x : α) (y : α) : SortOpsCmp α Bool + | cmpLE (x : α) (y : α) : SortOps α Bool /-- A model of `SortOps` that uses `ℕ` as the type for the cost of operations. In this model, @@ -137,7 +138,7 @@ presence of `[Std.Total le] [IsTrans _ le]`. -/ @[simps] def sortModelNat {α : Type*} - (le : α → α → Prop) [DecidableRel le] : Model (SortOpsCmp α) ℕ where + (le : α → α → Prop) [DecidableRel le] : Model (SortOps α) ℕ where evalQuery | .cmpLE x y => decide (le x y) cost _ := 1 From a9485da2709d341a6b0d6a2a111390809b5a3001 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 28 Feb 2026 18:36:15 +0100 Subject: [PATCH 18/75] Fix lake shake issues --- Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean | 2 +- Cslib/AlgorithmsTheory/QueryModel.lean | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index e0e9ce675..cee32bf2b 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -6,7 +6,7 @@ Authors: Shreyas Srinivas, Eric Wieser module public import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert -public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum @[expose] public section diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index d3f1fd877..c91beb60d 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -6,7 +6,7 @@ Authors: Tanner Duve, Shreyas Srinivas, Eric Wieser module -public import Cslib.Foundations.Control.Monad.Free.Fold +public import Cslib.Foundations.Control.Monad.Free public import Cslib.AlgorithmsTheory.Lean.TimeM @[expose] public section From 6fef51fb0dfcbb030689c06e276c85f88b04a1fa Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 28 Feb 2026 18:41:25 +0100 Subject: [PATCH 19/75] Done --- Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index 542502f09..9c685886a 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -8,9 +8,8 @@ module public import Cslib.AlgorithmsTheory.QueryModel public import Cslib.AlgorithmsTheory.Models.ListComparisonSearch +public import Batteries.Data.List public import Mathlib.Algebra.Order.Group.Nat -public import Mathlib.Data.Int.ConditionallyCompleteOrder -public import Mathlib.Order.ConditionallyCompleteLattice.Basic public import Mathlib.Tactic.Set @[expose] public section From f479c932c5e69882dbf3fb2ea4603a9f27c7b4cc Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 2 Mar 2026 03:01:43 +0100 Subject: [PATCH 20/75] Switch to bool --- .../Algorithms/ListInsertionSort.lean | 25 ++++++----- .../Algorithms/ListOrderedInsert.lean | 13 +++--- .../Algorithms/MergeSort.lean | 42 ++++++++++--------- .../Models/ListComparisonSort.lean | 8 ++-- 4 files changed, 49 insertions(+), 39 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index cee32bf2b..5bfb62d73 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -46,36 +46,39 @@ def insertionSort (l : List α) : Prog (SortOpsInsertHead α) (List α) := insertOrd x rest @[simp] -theorem insertionSort_eval (l : List α) (le : α → α → Prop) [DecidableRel le] : - (insertionSort l).eval (sortModel le) = l.insertionSort le := by +theorem insertionSort_eval (l : List α) (le : α → α → Bool) : + (insertionSort l).eval (sortModel le) = l.insertionSort (fun x y => le x y = true) := by induction l with simp_all [insertionSort] -theorem insertionSort_permutation (l : List α) (le : α → α → Prop) [DecidableRel le] : +theorem insertionSort_permutation (l : List α) (le : α → α → Bool) : ((insertionSort l).eval (sortModel le)).Perm l := by simp [insertionSort_eval, List.perm_insertionSort] theorem insertionSort_sorted - (l : List α) (le : α → α → Prop) [DecidableRel le] [Std.Total le] [IsTrans α le] : - ((insertionSort l).eval (sortModel le)).Pairwise le := by + (l : List α) (le : α → α → Bool) + [Std.Total (fun x y => le x y = true)] [IsTrans α (fun x y => le x y = true)] : + ((insertionSort l).eval (sortModel le)).Pairwise (fun x y => le x y = true) := by simpa using List.pairwise_insertionSort _ _ -lemma insertionSort_length (l : List α) (le : α → α → Prop) [DecidableRel le] : +lemma insertionSort_length (l : List α) (le : α → α → Bool) : ((insertionSort l).eval (sortModel le)).length = l.length := by simp -lemma insertionSort_time_compares (head : α) (tail : List α) (le : α → α → Prop) [DecidableRel le] : +lemma insertionSort_time_compares (head : α) (tail : List α) (le : α → α → Bool) : ((insertionSort (head :: tail)).time (sortModel le)).compares = ((insertionSort tail).time (sortModel le)).compares + - ((insertOrd head (tail.insertionSort le)).time (sortModel le)).compares := by + ((insertOrd head (tail.insertionSort (fun x y => le x y = true))).time + (sortModel le)).compares := by simp [insertionSort] -lemma insertionSort_time_inserts (head : α) (tail : List α) (le : α → α → Prop) [DecidableRel le] : +lemma insertionSort_time_inserts (head : α) (tail : List α) (le : α → α → Bool) : ((insertionSort (head :: tail)).time (sortModel le)).inserts = ((insertionSort tail).time (sortModel le)).inserts + - ((insertOrd head (tail.insertionSort le)).time (sortModel le)).inserts := by + ((insertOrd head (tail.insertionSort (fun x y => le x y = true))).time + (sortModel le)).inserts := by simp [insertionSort] -theorem insertionSort_complexity (l : List α) (le : α → α → Prop) [DecidableRel le] : +theorem insertionSort_complexity (l : List α) (le : α → α → Bool) : ((insertionSort l).time (sortModel le)) ≤ ⟨l.length * (l.length + 1), (l.length + 1) * (l.length + 2)⟩ := by induction l with diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 5a99a59ac..d4b4ea9fd 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -58,8 +58,8 @@ def insertOrd (x : α) (l : List α) : Prog (SortOpsInsertHead α) (List α) := insertHead a res @[simp] -lemma insertOrd_eval (x : α) (l : List α) (le : α → α → Prop) [DecidableRel le] : - (insertOrd x l).eval (sortModel le) = l.orderedInsert le x := by +lemma insertOrd_eval (x : α) (l : List α) (le : α → α → Bool) : + (insertOrd x l).eval (sortModel le) = l.orderedInsert (fun x y => le x y = true) x := by induction l with | nil => simp [insertOrd, sortModel] @@ -75,7 +75,7 @@ lemma _root_.List.length_orderedInsert (x : α) (l : List α) [DecidableRel r] : induction l <;> grind theorem insertOrd_complexity_upper_bound - (l : List α) (x : α) (le : α → α → Prop) [DecidableRel le] : + (l : List α) (x : α) (le : α → α → Bool) : (insertOrd x l).time (sortModel le) ≤ ⟨l.length, l.length + 1⟩ := by induction l with | nil => @@ -89,8 +89,11 @@ theorem insertOrd_complexity_upper_bound grind lemma insertOrd_sorted - (l : List α) (x : α) (le : α → α → Prop) [DecidableRel le] [Std.Total le] [IsTrans α le] : - l.Pairwise le → ((insertOrd x l).eval (sortModel le)).Pairwise le := by + (l : List α) (x : α) (le : α → α → Bool) + [Std.Total (fun x y => le x y)] + [IsTrans _ (fun x y => le x y)] : + l.Pairwise (fun x y => le x y) + → ((insertOrd x l).eval (sortModel le)).Pairwise (fun x y => le x y = true) := by rw [insertOrd_eval] exact List.Pairwise.orderedInsert _ _ diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index a96e1d2ad..7d76807a0 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -49,7 +49,7 @@ def merge (x y : List α) : Prog (SortOps α) (List α) := do let rest ← merge (x :: xs') ys' return (y :: rest) -lemma merge_timeComplexity (x y : List α) (le : α → α → Prop) [DecidableRel le] : +lemma merge_timeComplexity (x y : List α) (le : α → α → Bool) : (merge x y).time (sortModelNat le) ≤ x.length + y.length := by fun_induction List.merge x y (le · ·) with | case1 => simp @@ -64,11 +64,11 @@ lemma merge_timeComplexity (x y : List α) (le : α → α → Prop) [DecidableR grind @[simp] -lemma merge_eval (x y : List α) (le : α → α → Prop) [DecidableRel le] : +lemma merge_eval (x y : List α) (le : α → α → Bool) : (merge x y).eval (sortModelNat le) = List.merge x y (le · ·) := by fun_induction List.merge with simp_all [merge] -lemma merge_length (x y : List α) (le : α → α → Prop) [DecidableRel le] : +lemma merge_length (x y : List α) (le : α → α → Bool) : ((merge x y).eval (sortModelNat le)).length = x.length + y.length := by rw [merge_eval] apply List.length_merge @@ -90,7 +90,7 @@ def mergeSort (xs : List α) : Prog (SortOps α) (List α) := do /-- The vanilla-lean version of `mergeSortNaive` that is extensionally equal to `mergeSort` -/ -private def mergeSortNaive (xs : List α) (le : α → α → Prop) [DecidableRel le] : List α := +private def mergeSortNaive (xs : List α) (le : α → α → Bool) : List α := if xs.length < 2 then xs else let sortedLeft := mergeSortNaive (xs.take (xs.length/2)) le @@ -98,17 +98,17 @@ private def mergeSortNaive (xs : List α) (le : α → α → Prop) [DecidableRe List.merge sortedLeft sortedRight (le · ·) private proof_wanted mergeSortNaive_eq_mergeSort - [LinearOrder α] (xs : List α) (le : α → α → Prop) [DecidableRel le] : + [LinearOrder α] (xs : List α) (le : α → α → Bool) : mergeSortNaive xs le = xs.mergeSort -private lemma mergeSortNaive_Perm (xs : List α) (le : α → α → Prop) [DecidableRel le] : +private lemma mergeSortNaive_Perm (xs : List α) (le : α → α → Bool) : (mergeSortNaive xs le).Perm xs := by fun_induction mergeSortNaive with | case1 => simp | case2 x _ _ _ ih2 ih1 => grw [←List.take_append_drop _ x, List.merge_perm_append, ← ih1, ← ih2] @[simp] -private lemma mergeSort_eval (xs : List α) (le : α → α → Prop) [DecidableRel le] : +private lemma mergeSort_eval (xs : List α) (le : α → α → Bool) : (mergeSort xs).eval (sortModelNat le) = mergeSortNaive xs le := by fun_induction mergeSort with | case1 xs h => @@ -118,7 +118,7 @@ private lemma mergeSort_eval (xs : List α) (le : α → α → Prop) [Decidable simp [ihl, ihr, merge_eval] rfl -private lemma mergeSortNaive_length (xs : List α) (le : α → α → Prop) [DecidableRel le] : +private lemma mergeSortNaive_length (xs : List α) (le : α → α → Bool) : (mergeSortNaive xs le).length = xs.length := by fun_induction mergeSortNaive with | case1 xs h => @@ -129,21 +129,24 @@ private lemma mergeSortNaive_length (xs : List α) (le : α → α → Prop) [De rw [← List.length_append] simp -lemma mergeSort_length (xs : List α) (le : α → α → Prop) [DecidableRel le] : +lemma mergeSort_length (xs : List α) (le : α → α → Bool) : ((mergeSort xs).eval (sortModelNat le)).length = xs.length := by rw [mergeSort_eval] apply mergeSortNaive_length lemma merge_sorted_sorted - (xs ys : List α) (le : α → α → Prop) [DecidableRel le] [Std.Total le] [IsTrans _ le] - (hxs_mono : xs.Pairwise le) (hys_mono : ys.Pairwise le) : - ((merge xs ys).eval (sortModelNat le)).Pairwise le := by + (xs ys : List α) (le : α → α → Bool) [Std.Total (fun x y => le x y)] + [IsTrans _ (fun x y => le x y)] + (hxs_mono : xs.Pairwise (fun x y => le x y)) + (hys_mono : ys.Pairwise (fun x y => le x y)) : + ((merge xs ys).eval (sortModelNat le)).Pairwise (fun x y => le x y) := by rw [merge_eval] - grind [hxs_mono.merge hys_mono] + simpa using hxs_mono.merge hys_mono private lemma mergeSortNaive_sorted - (xs : List α) (le : α → α → Prop) [DecidableRel le] [Std.Total le] [IsTrans _ le] : - (mergeSortNaive xs le).Pairwise le := by + (xs : List α) (le : α → α → Bool) [Std.Total ((fun x y => le x y = true))] + [IsTrans _ ((fun x y => le x y = true))] : + (mergeSortNaive xs le).Pairwise ((fun x y => le x y = true)) := by fun_induction mergeSortNaive with | case1 xs h => match xs with | [] | [x] => simp @@ -151,12 +154,13 @@ private lemma mergeSortNaive_sorted simpa using ihl.merge ihr theorem mergeSort_sorted - (xs : List α) (le : α → α → Prop) [DecidableRel le] [Std.Total le] [IsTrans _ le] : - ((mergeSort xs).eval (sortModelNat le)).Pairwise le := by + (xs : List α) (le : α → α → Bool) [Std.Total (fun x y => le x y = true)] + [IsTrans _ (fun x y => le x y = true)] : + ((mergeSort xs).eval (sortModelNat le)).Pairwise ((fun x y => le x y = true)) := by rw [mergeSort_eval] apply mergeSortNaive_sorted -theorem mergeSort_perm (xs : List α) (le : α → α → Prop) [DecidableRel le] : +theorem mergeSort_perm (xs : List α) (le : α → α → Bool) : ((mergeSort xs).eval (sortModelNat le)).Perm xs := by rw [mergeSort_eval] apply mergeSortNaive_Perm @@ -166,7 +170,7 @@ section TimeComplexity open Cslib.Algorithms.Lean.TimeM -- TODO: reuse the work in `mergeSort_time_le`? -theorem mergeSort_complexity (xs : List α) (le : α → α → Prop) [DecidableRel le] : +theorem mergeSort_complexity (xs : List α) (le : α → α → Bool) : (mergeSort xs).time (sortModelNat le) ≤ T (xs.length) := by fun_induction mergeSort with | case1 => simp [T] diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 939491df9..4781fbf06 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -107,10 +107,10 @@ While this accepts any decidable relation `le`, most sorting algorithms are only presence of `[Std.Total le] [IsTrans _ le]`. -/ @[simps, grind] -def sortModel {α : Type} (le : α → α → Prop) [DecidableRel le] : +def sortModel {α : Type} (le : α → α → Bool) : Model (SortOpsInsertHead α) SortOpsCost where evalQuery - | .cmpLE x y => decide (le x y) + | .cmpLE x y => le x y | .insertHead x l => x :: l cost | .cmpLE _ _ => ⟨1,0⟩ @@ -138,9 +138,9 @@ presence of `[Std.Total le] [IsTrans _ le]`. -/ @[simps] def sortModelNat {α : Type*} - (le : α → α → Prop) [DecidableRel le] : Model (SortOps α) ℕ where + (le : α → α → Bool) : Model (SortOps α) ℕ where evalQuery - | .cmpLE x y => decide (le x y) + | .cmpLE x y => le x y cost _ := 1 end NatModel From 5e2a2f613e2e9038b1fe94d213b171bb3304fb9f Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 2 Mar 2026 17:31:14 +0100 Subject: [PATCH 21/75] Lower bound --- Cslib.lean | 1 + .../LowerBounds/ComparisonSort.lean | 45 +++++++++++++++++++ 2 files changed, 46 insertions(+) create mode 100644 Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean diff --git a/Cslib.lean b/Cslib.lean index b6a8f3f2e..d4a124f0f 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -4,6 +4,7 @@ public import Cslib.AlgorithmsTheory.Algorithms.ListInsertionSort public import Cslib.AlgorithmsTheory.Algorithms.ListLinearSearch public import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert public import Cslib.AlgorithmsTheory.Algorithms.MergeSort +public import Cslib.AlgorithmsTheory.LowerBounds.ComparisonSort public import Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort public import Cslib.AlgorithmsTheory.Lean.TimeM public import Cslib.AlgorithmsTheory.Models.ListComparisonSearch diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean new file mode 100644 index 000000000..f031269a2 --- /dev/null +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2025 Shreyas Srinivas. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Shreyas Srinivas +-/ + +module + +public import Cslib.AlgorithmsTheory.QueryModel +public import Cslib.AlgorithmsTheory.Models.ListComparisonSort +import all Init.Data.List.Sort.Basic + +public import Mathlib + +@[expose] public section + +namespace Cslib + +namespace Algorithms + +open Prog + +theorem cmpSort_lower_bound + (P : List α → Prog (SortOps α) (List α)) (le : α → α → Bool) + (l : List α) + (hLen : l.length ≤ 1) + [Std.Total (fun x y => le x y = true)] [IsTrans α (fun x y => le x y = true)] : + ((P l).eval (sortModelNat le)).Pairwise (fun x y => le x y = true) → + (P l).time (sortModelNat le) ≥ l.length * (Nat.log 2 l.length) := by + intro _ + cases l with + | nil => + simp + | cons x xs => + cases xs with + | nil => + simp + | cons y ys => + simp at hLen + + + +end Algorithms + +end Cslib From 6b78316f12e5609f5791aae24758374b9803cf71 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 2 Mar 2026 19:18:08 +0100 Subject: [PATCH 22/75] GPT generated lower bound --- .../LowerBounds/ComparisonSort.lean | 302 +++++++++++++++++- 1 file changed, 286 insertions(+), 16 deletions(-) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index f031269a2..10a810143 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -20,23 +20,293 @@ namespace Algorithms open Prog -theorem cmpSort_lower_bound - (P : List α → Prog (SortOps α) (List α)) (le : α → α → Bool) - (l : List α) - (hLen : l.length ≤ 1) - [Std.Total (fun x y => le x y = true)] [IsTrans α (fun x y => le x y = true)] : - ((P l).eval (sortModelNat le)).Pairwise (fun x y => le x y = true) → - (P l).time (sortModelNat le) ≥ l.length * (Nat.log 2 l.length) := by - intro _ - cases l with - | nil => +/-- +Finite pigeonhole/cardinality step: +if we can inject `m` distinguishable inputs into Boolean transcripts of length `t`, +then `m ≤ 2^t`. +-/ +lemma hDecisionTree + (m t : ℕ) + (traceCode : Fin m → (Fin t → Bool)) + (hTraceInj : Function.Injective traceCode) : + m ≤ 2 ^ t := by + simpa [Fintype.card_fun, Fintype.card_bool] using + (Fintype.card_le_of_injective traceCode hTraceInj) + +/-- +Pigeonhole principle in existential form. +-/ +lemma hDecisionTreeBound + (m t : ℕ) + (hTraceCode : + ∃ traceCode : Fin m → + (Fin t → Bool), + Function.Injective traceCode) : + m ≤ 2 ^ t := by + rcases hTraceCode with ⟨traceCode, hTraceInj⟩ + exact hDecisionTree m t traceCode hTraceInj + +/-- +Finite pigeonhole/cardinality step over an arbitrary finite domain. +-/ +lemma hDecisionTreeFintype + (β : Type*) [Fintype β] (t : ℕ) + (traceCode : β → (Fin t → Bool)) + (hTraceInj : Function.Injective traceCode) : + Fintype.card β ≤ 2 ^ t := by + simpa [Fintype.card_fun, Fintype.card_bool] using + (Fintype.card_le_of_injective traceCode hTraceInj) + +/-- +Arithmetic lower bound used to derive an `Ω(n log n)` comparison lower bound +from `Nat.log 2 (n!)`. +-/ +lemma hFactorialLog (n : ℕ) : + (n / 2) * Nat.log 2 (n / 2) ≤ Nat.log 2 (Nat.factorial n) := by + let k := n / 2 + change k * Nat.log 2 k ≤ Nat.log 2 (Nat.factorial n) + by_cases hk : k = 0 + · simp [hk] + · have hk_pos : 0 < k := Nat.pos_of_ne_zero hk + have hk_le_n : k ≤ n := by + simpa [k] using Nat.div_le_self n 2 + have h2k_le_n : k + k ≤ n := by + simpa [k, two_mul, Nat.mul_assoc, Nat.mul_left_comm, Nat.mul_comm] using Nat.mul_div_le n 2 + have hk_le_sub : k ≤ n - k := (Nat.le_sub_iff_add_le hk_le_n).2 h2k_le_n + have hPowLe : k ^ k ≤ k ^ (n - k) := + Nat.pow_le_pow_right hk_pos hk_le_sub + have hFactorialPow : Nat.factorial k * k ^ (n - k) ≤ Nat.factorial n := + Nat.factorial_mul_pow_sub_le_factorial hk_le_n + have hkPow_le_factorial : k ^ k ≤ Nat.factorial n := by + calc + k ^ k ≤ k ^ (n - k) := hPowLe + _ ≤ Nat.factorial k * k ^ (n - k) := Nat.le_mul_of_pos_left _ (Nat.factorial_pos k) + _ ≤ Nat.factorial n := hFactorialPow + have hLogPow : k * Nat.log 2 k ≤ Nat.log 2 (k ^ k) := by + have hPow : 2 ^ (k * Nat.log 2 k) ≤ k ^ k := by + calc + 2 ^ (k * Nat.log 2 k) = (2 ^ Nat.log 2 k) ^ k := by + rw [Nat.mul_comm, Nat.pow_mul] + _ ≤ k ^ k := Nat.pow_le_pow_left (Nat.pow_log_le_self 2 hk) k + exact Nat.le_log_of_pow_le (by decide : 1 < 2) hPow + have hLogMono : Nat.log 2 (k ^ k) ≤ Nat.log 2 (Nat.factorial n) := + Nat.log_mono_right hkPow_le_factorial + exact le_trans hLogPow hLogMono + +/-- The order on `Fin n` induced by a hidden permutation `σ`. -/ +def permLE {n : ℕ} (σ : Equiv.Perm (Fin n)) : Fin n → Fin n → Bool := + fun x y => decide (σ x ≤ σ y) + +/-- Canonical sorted output for the hidden order induced by `σ`. -/ +def permOutput {n : ℕ} (σ : Equiv.Perm (Fin n)) : List (Fin n) := + List.ofFn σ.symm + +lemma permOutput_injective {n : ℕ} : + Function.Injective (permOutput (n := n)) := by + intro σ τ h + have hsymm : (fun i => σ.symm i) = fun i => τ.symm i := List.ofFn_injective h + ext x + have hAt : σ.symm (τ x) = τ.symm (τ x) := by + simpa using congrArg (fun f => f (τ x)) hsymm + have hσ := congrArg σ hAt + simpa using (congrArg Fin.val hσ).symm + +/-- +Boolean transcript produced by running a comparison program under comparator `le`. +-/ +def traceSort : Prog (SortOps α) β → (α → α → Bool) → List Bool + | .pure _, _ => [] + | .liftBind q cont, le => + match q with + | .cmpLE x y => + let b := le x y + b :: traceSort (cont b) le + +@[simp] lemma traceSort_pure (x : β) (le : α → α → Bool) : + traceSort (.pure x : Prog (SortOps α) β) le = [] := rfl + +@[simp] lemma traceSort_liftBind (x y : α) (cont : Bool → Prog (SortOps α) β) (le : α → α → Bool) : + traceSort (.liftBind (SortOps.cmpLE x y) cont) le = + (le x y) :: traceSort (cont (le x y)) le := by + simp [traceSort] + +lemma traceSort_length_eq_time (P : Prog (SortOps α) β) (le : α → α → Bool) : + (traceSort P le).length = P.time (sortModelNat le) := by + induction P with + | pure a => + simp [traceSort] + | liftBind op cont ih => + cases op with + | cmpLE x y => + simp [traceSort, ih, Nat.add_comm] + +/-- +If two runs of a program have the same comparison transcript, then they have the same output. +-/ +lemma eval_eq_of_traceSort_eq + (P : Prog (SortOps α) β) {le₁ le₂ : α → α → Bool} + (h : traceSort P le₁ = traceSort P le₂) : + P.eval (sortModelNat le₁) = P.eval (sortModelNat le₂) := by + induction P generalizing le₁ le₂ with + | pure a => simp - | cons x xs => - cases xs with - | nil => - simp - | cons y ys => - simp at hLen + | liftBind op cont ih => + cases op with + | cmpLE x y => + have hcons : + (le₁ x y) :: traceSort (cont (le₁ x y)) le₁ = + (le₂ x y) :: traceSort (cont (le₂ x y)) le₂ := by + simpa [traceSort] using h + injection hcons with hhead htail + have htail' : + traceSort (cont (le₁ x y)) le₁ = + traceSort (cont (le₁ x y)) le₂ := by + simpa [hhead] using htail + simpa [Prog.eval_liftBind, hhead] using ih (le₁ x y) htail' + +/-- +For a fixed program, one transcript cannot be a strict prefix of another. +-/ +lemma traceSort_prefix_eq + (P : Prog (SortOps α) β) {le₁ le₂ : α → α → Bool} + (h : traceSort P le₁ <+: traceSort P le₂) : + traceSort P le₁ = traceSort P le₂ := by + induction P generalizing le₁ le₂ with + | pure a => + simp [traceSort] + | liftBind op cont ih => + cases op with + | cmpLE x y => + have hcons : + (le₁ x y) :: traceSort (cont (le₁ x y)) le₁ <+: + (le₂ x y) :: traceSort (cont (le₂ x y)) le₂ := by + simpa [traceSort] using h + rcases List.cons_prefix_cons.mp hcons with ⟨hhead, htail⟩ + have htail' : + traceSort (cont (le₁ x y)) le₁ <+: + traceSort (cont (le₁ x y)) le₂ := by + simpa [hhead] using htail + have hEqTail := ih (le₁ x y) htail' + have hEqTail' : + traceSort (cont (le₂ x y)) le₁ = + traceSort (cont (le₂ x y)) le₂ := by + simpa [hhead] using hEqTail + simp [traceSort, hhead, hEqTail'] + +/-- Pad a transcript with `false` bits up to a fixed length `t`. -/ +def padTrace (t : ℕ) (tr : List Bool) : Fin t → Bool := + fun i => (tr[i.1]?).getD false + +lemma isPrefix_of_padTrace_eq + {t : ℕ} {s₁ s₂ : List Bool} + (hs₁ : s₁.length ≤ t) (hLen : s₁.length ≤ s₂.length) + (hPad : padTrace t s₁ = padTrace t s₂) : + s₁ <+: s₂ := by + rw [List.prefix_iff_eq_take] + apply List.ext_getElem?' + intro i hi + have hTakeLen : (s₂.take s₁.length).length = s₁.length := by + simp [List.length_take, Nat.min_eq_left hLen] + have hi₁ : i < s₁.length := by + simpa [hTakeLen] using hi + have hi₂ : i < s₂.length := lt_of_lt_of_le hi₁ hLen + have hit : i < t := lt_of_lt_of_le hi₁ hs₁ + have hAt := congrArg (fun f => f ⟨i, hit⟩) hPad + calc + s₁[i]? = (s₁[i]?).getD false := by simp [hi₁] + _ = (s₂[i]?).getD false := by simpa [padTrace] using hAt + _ = s₂[i]? := by simp [hi₂] + _ = (s₂.take s₁.length)[i]? := by + simpa using (List.getElem?_take_of_lt (l := s₂) (i := i) (j := s₁.length) hi₁).symm + +lemma traceSort_eq_of_padTrace_eq + (P : Prog (SortOps α) β) {le₁ le₂ : α → α → Bool} {t : ℕ} + (hLen₁ : (traceSort P le₁).length ≤ t) + (hLen₂ : (traceSort P le₂).length ≤ t) + (hPad : padTrace t (traceSort P le₁) = padTrace t (traceSort P le₂)) : + traceSort P le₁ = traceSort P le₂ := by + by_cases hcmp : (traceSort P le₁).length ≤ (traceSort P le₂).length + · exact traceSort_prefix_eq P (isPrefix_of_padTrace_eq hLen₁ hcmp hPad) + · have hcmp' : (traceSort P le₂).length ≤ (traceSort P le₁).length := Nat.le_of_not_ge hcmp + have hEq21 : traceSort P le₂ = traceSort P le₁ := by + exact traceSort_prefix_eq P (isPrefix_of_padTrace_eq hLen₂ hcmp' hPad.symm) + exact hEq21.symm + +/-- Worst-case number of comparisons over all hidden permutations of `Fin n`. -/ +def worstTime {n : ℕ} (P : Prog (SortOps (Fin n)) (List (Fin n))) : ℕ := + (Finset.univ : Finset (Equiv.Perm (Fin n))).sup + (fun σ => P.time (sortModelNat (permLE σ))) + +/-- Fixed-length transcript code at depth `worstTime`. -/ +def traceCode {n : ℕ} (P : Prog (SortOps (Fin n)) (List (Fin n))) : + Equiv.Perm (Fin n) → (Fin (worstTime P) → Bool) := + fun σ => padTrace (worstTime P) (traceSort P (permLE σ)) + +lemma traceCode_injective + {n : ℕ} (P : Prog (SortOps (Fin n)) (List (Fin n))) + (hCorrect : ∀ σ : Equiv.Perm (Fin n), + P.eval (sortModelNat (permLE σ)) = permOutput σ) : + Function.Injective (traceCode P) := by + intro σ τ hCode + have hTimeσ : + P.time (sortModelNat (permLE σ)) ≤ + (Finset.univ : Finset (Equiv.Perm (Fin n))).sup + (fun ρ => P.time (sortModelNat (permLE ρ))) := by + exact Finset.le_sup + (s := (Finset.univ : Finset (Equiv.Perm (Fin n)))) + (f := fun ρ => P.time (sortModelNat (permLE ρ))) + (Finset.mem_univ σ) + have hTimeτ : + P.time (sortModelNat (permLE τ)) ≤ + (Finset.univ : Finset (Equiv.Perm (Fin n))).sup + (fun ρ => P.time (sortModelNat (permLE ρ))) := by + exact Finset.le_sup + (s := (Finset.univ : Finset (Equiv.Perm (Fin n)))) + (f := fun ρ => P.time (sortModelNat (permLE ρ))) + (Finset.mem_univ τ) + have hLenσ : (traceSort P (permLE σ)).length ≤ worstTime P := by + simpa [worstTime, traceSort_length_eq_time] using hTimeσ + have hLenτ : (traceSort P (permLE τ)).length ≤ worstTime P := by + simpa [worstTime, traceSort_length_eq_time] using hTimeτ + have hTrace : + traceSort P (permLE σ) = traceSort P (permLE τ) := by + exact traceSort_eq_of_padTrace_eq P hLenσ hLenτ hCode + have hEval : + P.eval (sortModelNat (permLE σ)) = P.eval (sortModelNat (permLE τ)) := + eval_eq_of_traceSort_eq P hTrace + have hOut : permOutput σ = permOutput τ := by + simpa [hCorrect σ, hCorrect τ] using hEval + exact permOutput_injective hOut + +/-- +Decision-tree lower bound in the strong hidden-permutation model: +`n!` distinct hidden orders require at least `log₂(n!)` worst-case comparisons. +-/ +lemma hDecisionTreeLower + {n : ℕ} (P : Prog (SortOps (Fin n)) (List (Fin n))) + (hCorrect : ∀ σ : Equiv.Perm (Fin n), + P.eval (sortModelNat (permLE σ)) = permOutput σ) : + Nat.factorial n ≤ 2 ^ worstTime P := by + have hCard : + Fintype.card (Equiv.Perm (Fin n)) ≤ 2 ^ worstTime P := + hDecisionTreeFintype (β := Equiv.Perm (Fin n)) (worstTime P) (traceCode P) + (traceCode_injective P hCorrect) + simpa [Fintype.card_perm] using hCard + + +theorem cmpSort_lower_bound + (n : ℕ) (P : Prog (SortOps (Fin n)) (List (Fin n))) + (hCorrect : ∀ σ : Equiv.Perm (Fin n), + P.eval (sortModelNat (permLE σ)) = permOutput σ) : + worstTime P ≥ (n / 2) * Nat.log 2 (n / 2) := by + have hDecision : Nat.factorial n ≤ 2 ^ worstTime P := + hDecisionTreeLower P hCorrect + have hLog : + Nat.log 2 (Nat.factorial n) ≤ Nat.log 2 (2 ^ worstTime P) := + Nat.log_mono_right hDecision + have hTime : Nat.log 2 (Nat.factorial n) ≤ worstTime P := by + simpa [Nat.log_pow (b := 2) (x := worstTime P) (by decide : 1 < 2)] using hLog + exact le_trans (hFactorialLog n) hTime From 4fab097a04294ffcc41ec16a9609f734ad81e063 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 2 Mar 2026 19:21:06 +0100 Subject: [PATCH 23/75] Added module --- Cslib.lean | 214 ++++++++++++++++++++++++------------------------ CslibTests.lean | 30 ++++--- 2 files changed, 120 insertions(+), 124 deletions(-) diff --git a/Cslib.lean b/Cslib.lean index d4a124f0f..ed9e9dfca 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,108 +1,106 @@ -module -- shake: keep-all - -public import Cslib.AlgorithmsTheory.Algorithms.ListInsertionSort -public import Cslib.AlgorithmsTheory.Algorithms.ListLinearSearch -public import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert -public import Cslib.AlgorithmsTheory.Algorithms.MergeSort -public import Cslib.AlgorithmsTheory.LowerBounds.ComparisonSort -public import Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort -public import Cslib.AlgorithmsTheory.Lean.TimeM -public import Cslib.AlgorithmsTheory.Models.ListComparisonSearch -public import Cslib.AlgorithmsTheory.Models.ListComparisonSort -public import Cslib.AlgorithmsTheory.QueryModel -public import Cslib.Computability.Automata.Acceptors.Acceptor -public import Cslib.Computability.Automata.Acceptors.OmegaAcceptor -public import Cslib.Computability.Automata.DA.Basic -public import Cslib.Computability.Automata.DA.Buchi -public import Cslib.Computability.Automata.DA.Congr -public import Cslib.Computability.Automata.DA.Prod -public import Cslib.Computability.Automata.DA.ToNA -public import Cslib.Computability.Automata.EpsilonNA.Basic -public import Cslib.Computability.Automata.EpsilonNA.ToNA -public import Cslib.Computability.Automata.NA.Basic -public import Cslib.Computability.Automata.NA.BuchiEquiv -public import Cslib.Computability.Automata.NA.BuchiInter -public import Cslib.Computability.Automata.NA.Concat -public import Cslib.Computability.Automata.NA.Hist -public import Cslib.Computability.Automata.NA.Loop -public import Cslib.Computability.Automata.NA.Pair -public import Cslib.Computability.Automata.NA.Prod -public import Cslib.Computability.Automata.NA.Sum -public import Cslib.Computability.Automata.NA.ToDA -public import Cslib.Computability.Automata.NA.Total -public import Cslib.Computability.Languages.Congruences.BuchiCongruence -public import Cslib.Computability.Languages.Congruences.RightCongruence -public import Cslib.Computability.Languages.ExampleEventuallyZero -public import Cslib.Computability.Languages.Language -public import Cslib.Computability.Languages.OmegaLanguage -public import Cslib.Computability.Languages.OmegaRegularLanguage -public import Cslib.Computability.Languages.RegularLanguage -public import Cslib.Computability.Machines.SingleTapeTuring.Basic -public import Cslib.Computability.URM.Basic -public import Cslib.Computability.URM.Computable -public import Cslib.Computability.URM.Defs -public import Cslib.Computability.URM.Execution -public import Cslib.Computability.URM.StandardForm -public import Cslib.Computability.URM.StraightLine -public import Cslib.Foundations.Combinatorics.InfiniteGraphRamsey -public import Cslib.Foundations.Control.Monad.Free -public import Cslib.Foundations.Control.Monad.Free.Effects -public import Cslib.Foundations.Control.Monad.Free.Fold -public import Cslib.Foundations.Data.BiTape -public import Cslib.Foundations.Data.FinFun -public import Cslib.Foundations.Data.HasFresh -public import Cslib.Foundations.Data.Nat.Segment -public import Cslib.Foundations.Data.OmegaSequence.Defs -public import Cslib.Foundations.Data.OmegaSequence.Flatten -public import Cslib.Foundations.Data.OmegaSequence.InfOcc -public import Cslib.Foundations.Data.OmegaSequence.Init -public import Cslib.Foundations.Data.OmegaSequence.Temporal -public import Cslib.Foundations.Data.RelatesInSteps -public import Cslib.Foundations.Data.Relation -public import Cslib.Foundations.Data.Set.Saturation -public import Cslib.Foundations.Data.StackTape -public import Cslib.Foundations.Lint.Basic -public import Cslib.Foundations.Semantics.FLTS.Basic -public import Cslib.Foundations.Semantics.FLTS.FLTSToLTS -public import Cslib.Foundations.Semantics.FLTS.LTSToFLTS -public import Cslib.Foundations.Semantics.FLTS.Prod -public import Cslib.Foundations.Semantics.LTS.Basic -public import Cslib.Foundations.Semantics.LTS.Bisimulation -public import Cslib.Foundations.Semantics.LTS.Simulation -public import Cslib.Foundations.Semantics.LTS.TraceEq -public import Cslib.Foundations.Syntax.Congruence -public import Cslib.Foundations.Syntax.Context -public import Cslib.Foundations.Syntax.HasAlphaEquiv -public import Cslib.Foundations.Syntax.HasSubstitution -public import Cslib.Foundations.Syntax.HasWellFormed -public import Cslib.Init -public import Cslib.Languages.CCS.Basic -public import Cslib.Languages.CCS.BehaviouralTheory -public import Cslib.Languages.CCS.Semantics -public import Cslib.Languages.CombinatoryLogic.Basic -public import Cslib.Languages.CombinatoryLogic.Confluence -public import Cslib.Languages.CombinatoryLogic.Defs -public import Cslib.Languages.CombinatoryLogic.Evaluation -public import Cslib.Languages.CombinatoryLogic.List -public import Cslib.Languages.CombinatoryLogic.Recursion -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Context -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Basic -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Opening -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Reduction -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Safety -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Subtype -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Typing -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.WellFormed -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Basic -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Safety -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.LcAt -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties -public import Cslib.Languages.LambdaCalculus.Named.Untyped.Basic -public import Cslib.Logics.HML.Basic -public import Cslib.Logics.LinearLogic.CLL.Basic -public import Cslib.Logics.LinearLogic.CLL.CutElimination -public import Cslib.Logics.LinearLogic.CLL.EtaExpansion -public import Cslib.Logics.LinearLogic.CLL.PhaseSemantics.Basic +import Cslib.AlgorithmsTheory.Algorithms.ListInsertionSort +import Cslib.AlgorithmsTheory.Algorithms.ListLinearSearch +import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert +import Cslib.AlgorithmsTheory.Algorithms.MergeSort +import Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort +import Cslib.AlgorithmsTheory.Lean.TimeM +import Cslib.AlgorithmsTheory.LowerBounds.ComparisonSort +import Cslib.AlgorithmsTheory.Models.ListComparisonSearch +import Cslib.AlgorithmsTheory.Models.ListComparisonSort +import Cslib.AlgorithmsTheory.QueryModel +import Cslib.Computability.Automata.Acceptors.Acceptor +import Cslib.Computability.Automata.Acceptors.OmegaAcceptor +import Cslib.Computability.Automata.DA.Basic +import Cslib.Computability.Automata.DA.Buchi +import Cslib.Computability.Automata.DA.Congr +import Cslib.Computability.Automata.DA.Prod +import Cslib.Computability.Automata.DA.ToNA +import Cslib.Computability.Automata.EpsilonNA.Basic +import Cslib.Computability.Automata.EpsilonNA.ToNA +import Cslib.Computability.Automata.NA.Basic +import Cslib.Computability.Automata.NA.BuchiEquiv +import Cslib.Computability.Automata.NA.BuchiInter +import Cslib.Computability.Automata.NA.Concat +import Cslib.Computability.Automata.NA.Hist +import Cslib.Computability.Automata.NA.Loop +import Cslib.Computability.Automata.NA.Pair +import Cslib.Computability.Automata.NA.Prod +import Cslib.Computability.Automata.NA.Sum +import Cslib.Computability.Automata.NA.ToDA +import Cslib.Computability.Automata.NA.Total +import Cslib.Computability.Languages.Congruences.BuchiCongruence +import Cslib.Computability.Languages.Congruences.RightCongruence +import Cslib.Computability.Languages.ExampleEventuallyZero +import Cslib.Computability.Languages.Language +import Cslib.Computability.Languages.OmegaLanguage +import Cslib.Computability.Languages.OmegaRegularLanguage +import Cslib.Computability.Languages.RegularLanguage +import Cslib.Computability.Machines.SingleTapeTuring.Basic +import Cslib.Computability.URM.Basic +import Cslib.Computability.URM.Computable +import Cslib.Computability.URM.Defs +import Cslib.Computability.URM.Execution +import Cslib.Computability.URM.StandardForm +import Cslib.Computability.URM.StraightLine +import Cslib.Foundations.Combinatorics.InfiniteGraphRamsey +import Cslib.Foundations.Control.Monad.Free +import Cslib.Foundations.Control.Monad.Free.Effects +import Cslib.Foundations.Control.Monad.Free.Fold +import Cslib.Foundations.Data.BiTape +import Cslib.Foundations.Data.FinFun +import Cslib.Foundations.Data.HasFresh +import Cslib.Foundations.Data.Nat.Segment +import Cslib.Foundations.Data.OmegaSequence.Defs +import Cslib.Foundations.Data.OmegaSequence.Flatten +import Cslib.Foundations.Data.OmegaSequence.InfOcc +import Cslib.Foundations.Data.OmegaSequence.Init +import Cslib.Foundations.Data.OmegaSequence.Temporal +import Cslib.Foundations.Data.RelatesInSteps +import Cslib.Foundations.Data.Relation +import Cslib.Foundations.Data.Set.Saturation +import Cslib.Foundations.Data.StackTape +import Cslib.Foundations.Lint.Basic +import Cslib.Foundations.Semantics.FLTS.Basic +import Cslib.Foundations.Semantics.FLTS.FLTSToLTS +import Cslib.Foundations.Semantics.FLTS.LTSToFLTS +import Cslib.Foundations.Semantics.FLTS.Prod +import Cslib.Foundations.Semantics.LTS.Basic +import Cslib.Foundations.Semantics.LTS.Bisimulation +import Cslib.Foundations.Semantics.LTS.Simulation +import Cslib.Foundations.Semantics.LTS.TraceEq +import Cslib.Foundations.Syntax.Congruence +import Cslib.Foundations.Syntax.Context +import Cslib.Foundations.Syntax.HasAlphaEquiv +import Cslib.Foundations.Syntax.HasSubstitution +import Cslib.Foundations.Syntax.HasWellFormed +import Cslib.Init +import Cslib.Languages.CCS.Basic +import Cslib.Languages.CCS.BehaviouralTheory +import Cslib.Languages.CCS.Semantics +import Cslib.Languages.CombinatoryLogic.Basic +import Cslib.Languages.CombinatoryLogic.Confluence +import Cslib.Languages.CombinatoryLogic.Defs +import Cslib.Languages.CombinatoryLogic.Evaluation +import Cslib.Languages.CombinatoryLogic.List +import Cslib.Languages.CombinatoryLogic.Recursion +import Cslib.Languages.LambdaCalculus.LocallyNameless.Context +import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Basic +import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Opening +import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Reduction +import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Safety +import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Subtype +import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Typing +import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.WellFormed +import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Basic +import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Safety +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.LcAt +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties +import Cslib.Languages.LambdaCalculus.Named.Untyped.Basic +import Cslib.Logics.HML.Basic +import Cslib.Logics.LinearLogic.CLL.Basic +import Cslib.Logics.LinearLogic.CLL.CutElimination +import Cslib.Logics.LinearLogic.CLL.EtaExpansion +import Cslib.Logics.LinearLogic.CLL.PhaseSemantics.Basic diff --git a/CslibTests.lean b/CslibTests.lean index c1c44021a..cd4a7c495 100644 --- a/CslibTests.lean +++ b/CslibTests.lean @@ -1,16 +1,14 @@ -module -- shake: keep-all - -public import CslibTests.Bisimulation -public import CslibTests.CCS -public import CslibTests.CLL -public import CslibTests.DFA -public import CslibTests.FreeMonad -public import CslibTests.GrindLint -public import CslibTests.HML -public import CslibTests.HasFresh -public import CslibTests.ImportWithMathlib -public import CslibTests.LTS -public import CslibTests.LambdaCalculus -public import CslibTests.QueryModel.ProgExamples -public import CslibTests.QueryModel.QueryExamples -public import CslibTests.Reduction +import CslibTests.Bisimulation +import CslibTests.CCS +import CslibTests.CLL +import CslibTests.DFA +import CslibTests.FreeMonad +import CslibTests.GrindLint +import CslibTests.HML +import CslibTests.HasFresh +import CslibTests.ImportWithMathlib +import CslibTests.LTS +import CslibTests.LambdaCalculus +import CslibTests.QueryModel.ProgExamples +import CslibTests.QueryModel.QueryExamples +import CslibTests.Reduction From 8097c61f739bb97c347f9f320b55d3e276be2e98 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 2 Mar 2026 20:08:32 +0100 Subject: [PATCH 24/75] exe mk_all --- Cslib.lean | 214 +++++++++--------- .../LowerBounds/ComparisonSort.lean | 17 ++ CslibTests.lean | 30 +-- 3 files changed, 141 insertions(+), 120 deletions(-) diff --git a/Cslib.lean b/Cslib.lean index ed9e9dfca..2fc4a8d06 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,106 +1,108 @@ -import Cslib.AlgorithmsTheory.Algorithms.ListInsertionSort -import Cslib.AlgorithmsTheory.Algorithms.ListLinearSearch -import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert -import Cslib.AlgorithmsTheory.Algorithms.MergeSort -import Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort -import Cslib.AlgorithmsTheory.Lean.TimeM -import Cslib.AlgorithmsTheory.LowerBounds.ComparisonSort -import Cslib.AlgorithmsTheory.Models.ListComparisonSearch -import Cslib.AlgorithmsTheory.Models.ListComparisonSort -import Cslib.AlgorithmsTheory.QueryModel -import Cslib.Computability.Automata.Acceptors.Acceptor -import Cslib.Computability.Automata.Acceptors.OmegaAcceptor -import Cslib.Computability.Automata.DA.Basic -import Cslib.Computability.Automata.DA.Buchi -import Cslib.Computability.Automata.DA.Congr -import Cslib.Computability.Automata.DA.Prod -import Cslib.Computability.Automata.DA.ToNA -import Cslib.Computability.Automata.EpsilonNA.Basic -import Cslib.Computability.Automata.EpsilonNA.ToNA -import Cslib.Computability.Automata.NA.Basic -import Cslib.Computability.Automata.NA.BuchiEquiv -import Cslib.Computability.Automata.NA.BuchiInter -import Cslib.Computability.Automata.NA.Concat -import Cslib.Computability.Automata.NA.Hist -import Cslib.Computability.Automata.NA.Loop -import Cslib.Computability.Automata.NA.Pair -import Cslib.Computability.Automata.NA.Prod -import Cslib.Computability.Automata.NA.Sum -import Cslib.Computability.Automata.NA.ToDA -import Cslib.Computability.Automata.NA.Total -import Cslib.Computability.Languages.Congruences.BuchiCongruence -import Cslib.Computability.Languages.Congruences.RightCongruence -import Cslib.Computability.Languages.ExampleEventuallyZero -import Cslib.Computability.Languages.Language -import Cslib.Computability.Languages.OmegaLanguage -import Cslib.Computability.Languages.OmegaRegularLanguage -import Cslib.Computability.Languages.RegularLanguage -import Cslib.Computability.Machines.SingleTapeTuring.Basic -import Cslib.Computability.URM.Basic -import Cslib.Computability.URM.Computable -import Cslib.Computability.URM.Defs -import Cslib.Computability.URM.Execution -import Cslib.Computability.URM.StandardForm -import Cslib.Computability.URM.StraightLine -import Cslib.Foundations.Combinatorics.InfiniteGraphRamsey -import Cslib.Foundations.Control.Monad.Free -import Cslib.Foundations.Control.Monad.Free.Effects -import Cslib.Foundations.Control.Monad.Free.Fold -import Cslib.Foundations.Data.BiTape -import Cslib.Foundations.Data.FinFun -import Cslib.Foundations.Data.HasFresh -import Cslib.Foundations.Data.Nat.Segment -import Cslib.Foundations.Data.OmegaSequence.Defs -import Cslib.Foundations.Data.OmegaSequence.Flatten -import Cslib.Foundations.Data.OmegaSequence.InfOcc -import Cslib.Foundations.Data.OmegaSequence.Init -import Cslib.Foundations.Data.OmegaSequence.Temporal -import Cslib.Foundations.Data.RelatesInSteps -import Cslib.Foundations.Data.Relation -import Cslib.Foundations.Data.Set.Saturation -import Cslib.Foundations.Data.StackTape -import Cslib.Foundations.Lint.Basic -import Cslib.Foundations.Semantics.FLTS.Basic -import Cslib.Foundations.Semantics.FLTS.FLTSToLTS -import Cslib.Foundations.Semantics.FLTS.LTSToFLTS -import Cslib.Foundations.Semantics.FLTS.Prod -import Cslib.Foundations.Semantics.LTS.Basic -import Cslib.Foundations.Semantics.LTS.Bisimulation -import Cslib.Foundations.Semantics.LTS.Simulation -import Cslib.Foundations.Semantics.LTS.TraceEq -import Cslib.Foundations.Syntax.Congruence -import Cslib.Foundations.Syntax.Context -import Cslib.Foundations.Syntax.HasAlphaEquiv -import Cslib.Foundations.Syntax.HasSubstitution -import Cslib.Foundations.Syntax.HasWellFormed -import Cslib.Init -import Cslib.Languages.CCS.Basic -import Cslib.Languages.CCS.BehaviouralTheory -import Cslib.Languages.CCS.Semantics -import Cslib.Languages.CombinatoryLogic.Basic -import Cslib.Languages.CombinatoryLogic.Confluence -import Cslib.Languages.CombinatoryLogic.Defs -import Cslib.Languages.CombinatoryLogic.Evaluation -import Cslib.Languages.CombinatoryLogic.List -import Cslib.Languages.CombinatoryLogic.Recursion -import Cslib.Languages.LambdaCalculus.LocallyNameless.Context -import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Basic -import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Opening -import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Reduction -import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Safety -import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Subtype -import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Typing -import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.WellFormed -import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Basic -import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Safety -import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic -import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta -import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence -import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.LcAt -import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties -import Cslib.Languages.LambdaCalculus.Named.Untyped.Basic -import Cslib.Logics.HML.Basic -import Cslib.Logics.LinearLogic.CLL.Basic -import Cslib.Logics.LinearLogic.CLL.CutElimination -import Cslib.Logics.LinearLogic.CLL.EtaExpansion -import Cslib.Logics.LinearLogic.CLL.PhaseSemantics.Basic +module -- shake: keep-all + +public import Cslib.AlgorithmsTheory.Algorithms.ListInsertionSort +public import Cslib.AlgorithmsTheory.Algorithms.ListLinearSearch +public import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert +public import Cslib.AlgorithmsTheory.Algorithms.MergeSort +public import Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort +public import Cslib.AlgorithmsTheory.Lean.TimeM +public import Cslib.AlgorithmsTheory.LowerBounds.ComparisonSort +public import Cslib.AlgorithmsTheory.Models.ListComparisonSearch +public import Cslib.AlgorithmsTheory.Models.ListComparisonSort +public import Cslib.AlgorithmsTheory.QueryModel +public import Cslib.Computability.Automata.Acceptors.Acceptor +public import Cslib.Computability.Automata.Acceptors.OmegaAcceptor +public import Cslib.Computability.Automata.DA.Basic +public import Cslib.Computability.Automata.DA.Buchi +public import Cslib.Computability.Automata.DA.Congr +public import Cslib.Computability.Automata.DA.Prod +public import Cslib.Computability.Automata.DA.ToNA +public import Cslib.Computability.Automata.EpsilonNA.Basic +public import Cslib.Computability.Automata.EpsilonNA.ToNA +public import Cslib.Computability.Automata.NA.Basic +public import Cslib.Computability.Automata.NA.BuchiEquiv +public import Cslib.Computability.Automata.NA.BuchiInter +public import Cslib.Computability.Automata.NA.Concat +public import Cslib.Computability.Automata.NA.Hist +public import Cslib.Computability.Automata.NA.Loop +public import Cslib.Computability.Automata.NA.Pair +public import Cslib.Computability.Automata.NA.Prod +public import Cslib.Computability.Automata.NA.Sum +public import Cslib.Computability.Automata.NA.ToDA +public import Cslib.Computability.Automata.NA.Total +public import Cslib.Computability.Languages.Congruences.BuchiCongruence +public import Cslib.Computability.Languages.Congruences.RightCongruence +public import Cslib.Computability.Languages.ExampleEventuallyZero +public import Cslib.Computability.Languages.Language +public import Cslib.Computability.Languages.OmegaLanguage +public import Cslib.Computability.Languages.OmegaRegularLanguage +public import Cslib.Computability.Languages.RegularLanguage +public import Cslib.Computability.Machines.SingleTapeTuring.Basic +public import Cslib.Computability.URM.Basic +public import Cslib.Computability.URM.Computable +public import Cslib.Computability.URM.Defs +public import Cslib.Computability.URM.Execution +public import Cslib.Computability.URM.StandardForm +public import Cslib.Computability.URM.StraightLine +public import Cslib.Foundations.Combinatorics.InfiniteGraphRamsey +public import Cslib.Foundations.Control.Monad.Free +public import Cslib.Foundations.Control.Monad.Free.Effects +public import Cslib.Foundations.Control.Monad.Free.Fold +public import Cslib.Foundations.Data.BiTape +public import Cslib.Foundations.Data.FinFun +public import Cslib.Foundations.Data.HasFresh +public import Cslib.Foundations.Data.Nat.Segment +public import Cslib.Foundations.Data.OmegaSequence.Defs +public import Cslib.Foundations.Data.OmegaSequence.Flatten +public import Cslib.Foundations.Data.OmegaSequence.InfOcc +public import Cslib.Foundations.Data.OmegaSequence.Init +public import Cslib.Foundations.Data.OmegaSequence.Temporal +public import Cslib.Foundations.Data.RelatesInSteps +public import Cslib.Foundations.Data.Relation +public import Cslib.Foundations.Data.Set.Saturation +public import Cslib.Foundations.Data.StackTape +public import Cslib.Foundations.Lint.Basic +public import Cslib.Foundations.Semantics.FLTS.Basic +public import Cslib.Foundations.Semantics.FLTS.FLTSToLTS +public import Cslib.Foundations.Semantics.FLTS.LTSToFLTS +public import Cslib.Foundations.Semantics.FLTS.Prod +public import Cslib.Foundations.Semantics.LTS.Basic +public import Cslib.Foundations.Semantics.LTS.Bisimulation +public import Cslib.Foundations.Semantics.LTS.Simulation +public import Cslib.Foundations.Semantics.LTS.TraceEq +public import Cslib.Foundations.Syntax.Congruence +public import Cslib.Foundations.Syntax.Context +public import Cslib.Foundations.Syntax.HasAlphaEquiv +public import Cslib.Foundations.Syntax.HasSubstitution +public import Cslib.Foundations.Syntax.HasWellFormed +public import Cslib.Init +public import Cslib.Languages.CCS.Basic +public import Cslib.Languages.CCS.BehaviouralTheory +public import Cslib.Languages.CCS.Semantics +public import Cslib.Languages.CombinatoryLogic.Basic +public import Cslib.Languages.CombinatoryLogic.Confluence +public import Cslib.Languages.CombinatoryLogic.Defs +public import Cslib.Languages.CombinatoryLogic.Evaluation +public import Cslib.Languages.CombinatoryLogic.List +public import Cslib.Languages.CombinatoryLogic.Recursion +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Context +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Basic +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Opening +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Reduction +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Safety +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Subtype +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Typing +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.WellFormed +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Basic +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Safety +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.LcAt +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties +public import Cslib.Languages.LambdaCalculus.Named.Untyped.Basic +public import Cslib.Logics.HML.Basic +public import Cslib.Logics.LinearLogic.CLL.Basic +public import Cslib.Logics.LinearLogic.CLL.CutElimination +public import Cslib.Logics.LinearLogic.CLL.EtaExpansion +public import Cslib.Logics.LinearLogic.CLL.PhaseSemantics.Basic diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index 10a810143..b3d01e2ef 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -101,6 +101,12 @@ def permLE {n : ℕ} (σ : Equiv.Perm (Fin n)) : Fin n → Fin n → Bool := def permOutput {n : ℕ} (σ : Equiv.Perm (Fin n)) : List (Fin n) := List.ofFn σ.symm +lemma permOutput_pairwise {n : ℕ} (σ : Equiv.Perm (Fin n)) : + (permOutput σ).Pairwise (fun x y => permLE σ x y = true) := by + rw [permOutput, List.pairwise_ofFn] + intro i j hij + simpa [permLE, decide_eq_true_eq] using (le_of_lt hij) + lemma permOutput_injective {n : ℕ} : Function.Injective (permOutput (n := n)) := by intro σ τ h @@ -293,7 +299,18 @@ lemma hDecisionTreeLower (traceCode_injective P hCorrect) simpa [Fintype.card_perm] using hCard +lemma eval_pairwise_of_correct + {n : ℕ} (P : Prog (SortOps (Fin n)) (List (Fin n))) + (hCorrect : ∀ σ : Equiv.Perm (Fin n), + P.eval (sortModelNat (permLE σ)) = permOutput σ) + (σ : Equiv.Perm (Fin n)) : + (P.eval (sortModelNat (permLE σ))).Pairwise (fun x y => permLE σ x y = true) := by + simpa [hCorrect σ] using permOutput_pairwise σ +/-- +GPT suggested to pick an abitrary hidden permutation of `Fin n` and generate a list from it +and then prove that for this, sorting takes `n /2 * (Nat.log 2 (n / 2))` +-/ theorem cmpSort_lower_bound (n : ℕ) (P : Prog (SortOps (Fin n)) (List (Fin n))) (hCorrect : ∀ σ : Equiv.Perm (Fin n), diff --git a/CslibTests.lean b/CslibTests.lean index cd4a7c495..c1c44021a 100644 --- a/CslibTests.lean +++ b/CslibTests.lean @@ -1,14 +1,16 @@ -import CslibTests.Bisimulation -import CslibTests.CCS -import CslibTests.CLL -import CslibTests.DFA -import CslibTests.FreeMonad -import CslibTests.GrindLint -import CslibTests.HML -import CslibTests.HasFresh -import CslibTests.ImportWithMathlib -import CslibTests.LTS -import CslibTests.LambdaCalculus -import CslibTests.QueryModel.ProgExamples -import CslibTests.QueryModel.QueryExamples -import CslibTests.Reduction +module -- shake: keep-all + +public import CslibTests.Bisimulation +public import CslibTests.CCS +public import CslibTests.CLL +public import CslibTests.DFA +public import CslibTests.FreeMonad +public import CslibTests.GrindLint +public import CslibTests.HML +public import CslibTests.HasFresh +public import CslibTests.ImportWithMathlib +public import CslibTests.LTS +public import CslibTests.LambdaCalculus +public import CslibTests.QueryModel.ProgExamples +public import CslibTests.QueryModel.QueryExamples +public import CslibTests.Reduction From 87e7dedac3754200f561887013f1f8d43c2b6db4 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 2 Mar 2026 20:14:49 +0100 Subject: [PATCH 25/75] Minimize imports --- Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index b3d01e2ef..e12c31036 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -6,8 +6,13 @@ Authors: Shreyas Srinivas module -public import Cslib.AlgorithmsTheory.QueryModel public import Cslib.AlgorithmsTheory.Models.ListComparisonSort +public import Mathlib.Algebra.Order.Group.Nat +public import Mathlib.Algebra.Ring.Nat +public import Mathlib.Data.Fintype.BigOperators +public import Mathlib.Data.Fintype.Perm +public import Mathlib.Data.Nat.Lattice +public import Mathlib.Data.Nat.Log import all Init.Data.List.Sort.Basic public import Mathlib @@ -325,8 +330,6 @@ theorem cmpSort_lower_bound simpa [Nat.log_pow (b := 2) (x := worstTime P) (by decide : 1 < 2)] using hLog exact le_trans (hFactorialLog n) hTime - - end Algorithms end Cslib From 3f71048848a300aebbd1897fdbded70ff7446472 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 2 Mar 2026 23:01:17 +0100 Subject: [PATCH 26/75] Done --- .../LowerBounds/ComparisonSort.lean | 142 ++++++++++++++++++ 1 file changed, 142 insertions(+) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index e12c31036..c7d3095ca 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -330,6 +330,148 @@ theorem cmpSort_lower_bound simpa [Nat.log_pow (b := 2) (x := worstTime P) (by decide : 1 < 2)] using hLog exact le_trans (hFactorialLog n) hTime +section HiddenOrderEquiv + +/-- Hidden order induced by a permutation after encoding elements with `e : β ≃ Fin n`. -/ +def permLEEquiv {β : Type} {n : ℕ} + (e : β ≃ Fin n) (σ : Equiv.Perm (Fin n)) : β → β → Bool := + fun x y => decide (σ (e x) ≤ σ (e y)) + +/-- Canonical sorted output induced by `σ`, transported through `e`. -/ +def permOutputEquiv {β : Type} {n : ℕ} + (e : β ≃ Fin n) (σ : Equiv.Perm (Fin n)) : List β := + List.ofFn (fun i => e.symm (σ.symm i)) + +lemma permOutputEquiv_pairwise {β : Type} {n : ℕ} + (e : β ≃ Fin n) (σ : Equiv.Perm (Fin n)) : + (permOutputEquiv e σ).Pairwise (fun x y => permLEEquiv e σ x y = true) := by + rw [permOutputEquiv, List.pairwise_ofFn] + intro i j hij + simpa [permLEEquiv, decide_eq_true_eq] using (le_of_lt hij) + +lemma permOutputEquiv_injective {β : Type} {n : ℕ} + (e : β ≃ Fin n) : + Function.Injective (permOutputEquiv e) := by + intro σ τ h + have hsymm : + (fun i => e.symm (σ.symm i)) = fun i => e.symm (τ.symm i) := + List.ofFn_injective h + ext x + have hAt : e.symm (σ.symm (τ x)) = e.symm (τ.symm (τ x)) := by + simpa using congrArg (fun f => f (τ x)) hsymm + have hAt' : σ.symm (τ x) = τ.symm (τ x) := by + simpa using congrArg e hAt + have hσ : τ x = σ x := by + simpa using congrArg σ hAt' + simpa [eq_comm] using congrArg Fin.val hσ + +/-- Worst-case comparisons over hidden permutations, transported through `e`. -/ +def worstTimeEquiv {β : Type} {n : ℕ} + (e : β ≃ Fin n) (P : Prog (SortOps β) (List β)) : ℕ := + (Finset.univ : Finset (Equiv.Perm (Fin n))).sup + (fun σ => Prog.time P (sortModelNat (α := β) (permLEEquiv e σ))) + +/-- Fixed-length transcript code at depth `worstTimeEquiv`. -/ +def traceCodeEquiv {β : Type} {n : ℕ} + (e : β ≃ Fin n) (P : Prog (SortOps β) (List β)) : + Equiv.Perm (Fin n) → (Fin (worstTimeEquiv e P) → Bool) := + fun σ => padTrace (worstTimeEquiv e P) (traceSort P (permLEEquiv e σ)) + +lemma traceCodeEquiv_injective + {β : Type} {n : ℕ} + (e : β ≃ Fin n) (P : Prog (SortOps β) (List β)) + (hCorrect : ∀ σ : Equiv.Perm (Fin n), + Prog.eval P (sortModelNat (α := β) (permLEEquiv e σ)) = permOutputEquiv e σ) : + Function.Injective (traceCodeEquiv e P) := by + intro σ τ hCode + have hTimeσ : + Prog.time P (sortModelNat (α := β) (permLEEquiv e σ)) ≤ + (Finset.univ : Finset (Equiv.Perm (Fin n))).sup + (fun ρ => Prog.time P (sortModelNat (α := β) (permLEEquiv e ρ))) := by + exact Finset.le_sup + (s := (Finset.univ : Finset (Equiv.Perm (Fin n)))) + (f := fun ρ => Prog.time P (sortModelNat (α := β) (permLEEquiv e ρ))) + (Finset.mem_univ σ) + have hTimeτ : + Prog.time P (sortModelNat (α := β) (permLEEquiv e τ)) ≤ + (Finset.univ : Finset (Equiv.Perm (Fin n))).sup + (fun ρ => Prog.time P (sortModelNat (α := β) (permLEEquiv e ρ))) := by + exact Finset.le_sup + (s := (Finset.univ : Finset (Equiv.Perm (Fin n)))) + (f := fun ρ => Prog.time P (sortModelNat (α := β) (permLEEquiv e ρ))) + (Finset.mem_univ τ) + have hLenσ : (traceSort P (permLEEquiv e σ)).length ≤ worstTimeEquiv e P := by + simpa [worstTimeEquiv, traceSort_length_eq_time] using hTimeσ + have hLenτ : (traceSort P (permLEEquiv e τ)).length ≤ worstTimeEquiv e P := by + simpa [worstTimeEquiv, traceSort_length_eq_time] using hTimeτ + have hTrace : + traceSort P (permLEEquiv e σ) = traceSort P (permLEEquiv e τ) := by + exact traceSort_eq_of_padTrace_eq P hLenσ hLenτ hCode + have hEval : + Prog.eval P (sortModelNat (α := β) (permLEEquiv e σ)) = + Prog.eval P (sortModelNat (α := β) (permLEEquiv e τ)) := + eval_eq_of_traceSort_eq P hTrace + have hOut : permOutputEquiv e σ = permOutputEquiv e τ := by + simpa [hCorrect σ, hCorrect τ] using hEval + exact permOutputEquiv_injective e hOut + +lemma hDecisionTreeLowerEquiv + {β : Type} {n : ℕ} + (e : β ≃ Fin n) (P : Prog (SortOps β) (List β)) + (hCorrect : ∀ σ : Equiv.Perm (Fin n), + Prog.eval P (sortModelNat (α := β) (permLEEquiv e σ)) = permOutputEquiv e σ) : + Nat.factorial n ≤ 2 ^ worstTimeEquiv e P := by + have hCard : + Fintype.card (Equiv.Perm (Fin n)) ≤ 2 ^ worstTimeEquiv e P := + hDecisionTreeFintype (β := Equiv.Perm (Fin n)) (worstTimeEquiv e P) (traceCodeEquiv e P) + (traceCodeEquiv_injective e P hCorrect) + simpa [Fintype.card_perm] using hCard + +/-- `Ω(n log n)` lower bound on any type equivalent to `Fin n`. -/ +theorem cmpSort_lower_bound_equiv + {β : Type} {n : ℕ} + (e : β ≃ Fin n) (P : Prog (SortOps β) (List β)) + (hCorrect : ∀ σ : Equiv.Perm (Fin n), + Prog.eval P (sortModelNat (α := β) (permLEEquiv e σ)) = permOutputEquiv e σ) : + worstTimeEquiv e P ≥ (n / 2) * Nat.log 2 (n / 2) := by + have hDecision : Nat.factorial n ≤ 2 ^ worstTimeEquiv e P := + hDecisionTreeLowerEquiv e P hCorrect + have hLog : + Nat.log 2 (Nat.factorial n) ≤ Nat.log 2 (2 ^ worstTimeEquiv e P) := + Nat.log_mono_right hDecision + have hTime : Nat.log 2 (Nat.factorial n) ≤ worstTimeEquiv e P := by + simpa [Nat.log_pow (b := 2) (x := worstTimeEquiv e P) (by decide : 1 < 2)] using hLog + exact le_trans (hFactorialLog n) hTime + +/-- `Ω(n log n)` lower bound stated directly for a finite carrier type `α`. -/ +theorem cmpSort_lower_bound_fintype + (α : Type) [Fintype α] + (P : Prog (SortOps α) (List α)) + (hCorrect : ∀ σ : Equiv.Perm (Fin (Fintype.card α)), + Prog.eval P (sortModelNat (α := α) (permLEEquiv (Fintype.equivFin α) σ)) = + permOutputEquiv (Fintype.equivFin α) σ) : + worstTimeEquiv (Fintype.equivFin α) P ≥ + (Fintype.card α / 2) * Nat.log 2 (Fintype.card α / 2) := by + simpa using cmpSort_lower_bound_equiv (e := Fintype.equivFin α) (P := P) hCorrect + +/-- +Lower bound specialized to a fixed nodup list `l`. +This is a corollary of the fintype statement with carrier `{x // x ∈ l}`. +-/ +theorem cmpSort_lower_bound_nodup_list + {α : Type} [DecidableEq α] + (l : List α) (hNodup : l.Nodup) + (P : Prog (SortOps {x // x ∈ l}) (List {x // x ∈ l})) + (hCorrect : ∀ σ : Equiv.Perm (Fin l.length), + Prog.eval P (sortModelNat (α := {x // x ∈ l}) + (permLEEquiv (List.Nodup.getEquiv l hNodup).symm σ)) = + permOutputEquiv (List.Nodup.getEquiv l hNodup).symm σ) : + worstTimeEquiv (List.Nodup.getEquiv l hNodup).symm P ≥ + (l.length / 2) * Nat.log 2 (l.length / 2) := by + simpa using cmpSort_lower_bound_equiv (List.Nodup.getEquiv l hNodup).symm P hCorrect + +end HiddenOrderEquiv + end Algorithms end Cslib From 57856b762dfc3879cdb541b8ecc191ff927aa25e Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 2 Mar 2026 23:06:27 +0100 Subject: [PATCH 27/75] GPT finished the proof for lists with nodup --- .../LowerBounds/ComparisonSort.lean | 54 ++++--------------- 1 file changed, 10 insertions(+), 44 deletions(-) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index c7d3095ca..1e163fd82 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -384,36 +384,18 @@ lemma traceCodeEquiv_injective Prog.eval P (sortModelNat (α := β) (permLEEquiv e σ)) = permOutputEquiv e σ) : Function.Injective (traceCodeEquiv e P) := by intro σ τ hCode - have hTimeσ : - Prog.time P (sortModelNat (α := β) (permLEEquiv e σ)) ≤ - (Finset.univ : Finset (Equiv.Perm (Fin n))).sup - (fun ρ => Prog.time P (sortModelNat (α := β) (permLEEquiv e ρ))) := by - exact Finset.le_sup - (s := (Finset.univ : Finset (Equiv.Perm (Fin n)))) - (f := fun ρ => Prog.time P (sortModelNat (α := β) (permLEEquiv e ρ))) - (Finset.mem_univ σ) - have hTimeτ : - Prog.time P (sortModelNat (α := β) (permLEEquiv e τ)) ≤ - (Finset.univ : Finset (Equiv.Perm (Fin n))).sup - (fun ρ => Prog.time P (sortModelNat (α := β) (permLEEquiv e ρ))) := by - exact Finset.le_sup - (s := (Finset.univ : Finset (Equiv.Perm (Fin n)))) - (f := fun ρ => Prog.time P (sortModelNat (α := β) (permLEEquiv e ρ))) - (Finset.mem_univ τ) - have hLenσ : (traceSort P (permLEEquiv e σ)).length ≤ worstTimeEquiv e P := by - simpa [worstTimeEquiv, traceSort_length_eq_time] using hTimeσ - have hLenτ : (traceSort P (permLEEquiv e τ)).length ≤ worstTimeEquiv e P := by - simpa [worstTimeEquiv, traceSort_length_eq_time] using hTimeτ + have hLen (ρ : Equiv.Perm (Fin n)) : + (traceSort P (permLEEquiv e ρ)).length ≤ worstTimeEquiv e P := by + simpa [worstTimeEquiv, traceSort_length_eq_time] using + (Finset.le_sup + (s := (Finset.univ : Finset (Equiv.Perm (Fin n)))) + (f := fun ρ => Prog.time P (sortModelNat (α := β) (permLEEquiv e ρ))) + (Finset.mem_univ ρ)) have hTrace : traceSort P (permLEEquiv e σ) = traceSort P (permLEEquiv e τ) := by - exact traceSort_eq_of_padTrace_eq P hLenσ hLenτ hCode - have hEval : - Prog.eval P (sortModelNat (α := β) (permLEEquiv e σ)) = - Prog.eval P (sortModelNat (α := β) (permLEEquiv e τ)) := - eval_eq_of_traceSort_eq P hTrace - have hOut : permOutputEquiv e σ = permOutputEquiv e τ := by - simpa [hCorrect σ, hCorrect τ] using hEval - exact permOutputEquiv_injective e hOut + exact traceSort_eq_of_padTrace_eq P (hLen σ) (hLen τ) hCode + exact permOutputEquiv_injective e <| by + simpa [hCorrect σ, hCorrect τ] using eval_eq_of_traceSort_eq P hTrace lemma hDecisionTreeLowerEquiv {β : Type} {n : ℕ} @@ -454,22 +436,6 @@ theorem cmpSort_lower_bound_fintype (Fintype.card α / 2) * Nat.log 2 (Fintype.card α / 2) := by simpa using cmpSort_lower_bound_equiv (e := Fintype.equivFin α) (P := P) hCorrect -/-- -Lower bound specialized to a fixed nodup list `l`. -This is a corollary of the fintype statement with carrier `{x // x ∈ l}`. --/ -theorem cmpSort_lower_bound_nodup_list - {α : Type} [DecidableEq α] - (l : List α) (hNodup : l.Nodup) - (P : Prog (SortOps {x // x ∈ l}) (List {x // x ∈ l})) - (hCorrect : ∀ σ : Equiv.Perm (Fin l.length), - Prog.eval P (sortModelNat (α := {x // x ∈ l}) - (permLEEquiv (List.Nodup.getEquiv l hNodup).symm σ)) = - permOutputEquiv (List.Nodup.getEquiv l hNodup).symm σ) : - worstTimeEquiv (List.Nodup.getEquiv l hNodup).symm P ≥ - (l.length / 2) * Nat.log 2 (l.length / 2) := by - simpa using cmpSort_lower_bound_equiv (List.Nodup.getEquiv l hNodup).symm P hCorrect - end HiddenOrderEquiv end Algorithms From 53c2ef3e0fd2e1ce3cb09b8990461be7e1c5eef8 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 2 Mar 2026 23:14:25 +0100 Subject: [PATCH 28/75] Got it for infinite types as well --- .../LowerBounds/ComparisonSort.lean | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index 1e163fd82..0934a0b70 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -436,6 +436,22 @@ theorem cmpSort_lower_bound_fintype (Fintype.card α / 2) * Nat.log 2 (Fintype.card α / 2) := by simpa using cmpSort_lower_bound_equiv (e := Fintype.equivFin α) (P := P) hCorrect +/-- +Lower bound specialized to a fixed nodup list `l`. +This is a corollary of the fintype statement with carrier `{x // x ∈ l}`. +-/ +theorem cmpSort_lower_bound_infinite_types + {α : Type} [DecidableEq α] + (l : List α) (hNodup : l.Nodup) + (P : Prog (SortOps {x // x ∈ l}) (List {x // x ∈ l})) + (hCorrect : ∀ σ : Equiv.Perm (Fin l.length), + Prog.eval P (sortModelNat (α := {x // x ∈ l}) + (permLEEquiv (List.Nodup.getEquiv l hNodup).symm σ)) = + permOutputEquiv (List.Nodup.getEquiv l hNodup).symm σ) : + worstTimeEquiv (List.Nodup.getEquiv l hNodup).symm P ≥ + (l.length / 2) * Nat.log 2 (l.length / 2) := by + simpa using cmpSort_lower_bound_equiv (List.Nodup.getEquiv l hNodup).symm P hCorrect + end HiddenOrderEquiv end Algorithms From b712d1690973bcbfbdd2977ad164103cec4a8dfe Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 3 Mar 2026 14:41:53 +0100 Subject: [PATCH 29/75] remove deicsion tree proofs --- .../LowerBounds/ComparisonSort.lean | 26 ------------------- 1 file changed, 26 deletions(-) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index 0934a0b70..03d10004b 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -25,32 +25,6 @@ namespace Algorithms open Prog -/-- -Finite pigeonhole/cardinality step: -if we can inject `m` distinguishable inputs into Boolean transcripts of length `t`, -then `m ≤ 2^t`. --/ -lemma hDecisionTree - (m t : ℕ) - (traceCode : Fin m → (Fin t → Bool)) - (hTraceInj : Function.Injective traceCode) : - m ≤ 2 ^ t := by - simpa [Fintype.card_fun, Fintype.card_bool] using - (Fintype.card_le_of_injective traceCode hTraceInj) - -/-- -Pigeonhole principle in existential form. --/ -lemma hDecisionTreeBound - (m t : ℕ) - (hTraceCode : - ∃ traceCode : Fin m → - (Fin t → Bool), - Function.Injective traceCode) : - m ≤ 2 ^ t := by - rcases hTraceCode with ⟨traceCode, hTraceInj⟩ - exact hDecisionTree m t traceCode hTraceInj - /-- Finite pigeonhole/cardinality step over an arbitrary finite domain. -/ From 275d82734b721309d38f0d19ce78c1b3310ce095 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 16 Mar 2026 14:17:16 +0100 Subject: [PATCH 30/75] Merge upstream main --- .../Algorithms/SingletapeTMAlgorithms/Basics.lean | 0 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 Cslib/AlgorithmsTheory/Algorithms/SingletapeTMAlgorithms/Basics.lean diff --git a/Cslib/AlgorithmsTheory/Algorithms/SingletapeTMAlgorithms/Basics.lean b/Cslib/AlgorithmsTheory/Algorithms/SingletapeTMAlgorithms/Basics.lean new file mode 100644 index 000000000..e69de29bb From e9cb64815b00952ab6111bafb329ecf99959e58b Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 17 Mar 2026 02:26:40 +0100 Subject: [PATCH 31/75] Remove accidental file --- .../Algorithms/SingletapeTMAlgorithms/Basics.lean | 0 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 Cslib/AlgorithmsTheory/Algorithms/SingletapeTMAlgorithms/Basics.lean diff --git a/Cslib/AlgorithmsTheory/Algorithms/SingletapeTMAlgorithms/Basics.lean b/Cslib/AlgorithmsTheory/Algorithms/SingletapeTMAlgorithms/Basics.lean deleted file mode 100644 index e69de29bb..000000000 From 7f4010e550b8aab44400bb1e6e69e825524f4f87 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 17 Mar 2026 23:09:45 +0100 Subject: [PATCH 32/75] Initialize clean up of lower bound proof --- Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean | 2 -- 1 file changed, 2 deletions(-) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index 03d10004b..558796403 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -15,8 +15,6 @@ public import Mathlib.Data.Nat.Lattice public import Mathlib.Data.Nat.Log import all Init.Data.List.Sort.Basic -public import Mathlib - @[expose] public section namespace Cslib From d04ca7375ecafbd63d63b7e844e45000a899cbee Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 17 Mar 2026 23:54:26 +0100 Subject: [PATCH 33/75] Include the model parametric style lower bound in the lower bound file --- .../LowerBounds/ComparisonSort.lean | 255 ++++++++++++++++-- 1 file changed, 232 insertions(+), 23 deletions(-) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index 558796403..b214bea2a 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -70,6 +70,16 @@ lemma hFactorialLog (n : ℕ) : Nat.log_mono_right hkPow_le_factorial exact le_trans hLogPow hLogMono +/-- Convert a decision-tree counting inequality into the `Ω(n log n)` bound. -/ +lemma lowerBound_of_factorial_le_pow + (n t : ℕ) (hDecision : Nat.factorial n ≤ 2 ^ t) : + (n / 2) * Nat.log 2 (n / 2) ≤ t := by + have hLog : Nat.log 2 (Nat.factorial n) ≤ Nat.log 2 (2 ^ t) := + Nat.log_mono_right hDecision + have hTime : Nat.log 2 (Nat.factorial n) ≤ t := by + simpa [Nat.log_pow (b := 2) (x := t) (by decide : 1 < 2)] using hLog + exact le_trans (hFactorialLog n) hTime + /-- The order on `Fin n` induced by a hidden permutation `σ`. -/ def permLE {n : ℕ} (σ : Equiv.Perm (Fin n)) : Fin n → Fin n → Bool := fun x y => decide (σ x ≤ σ y) @@ -121,7 +131,7 @@ lemma traceSort_length_eq_time (P : Prog (SortOps α) β) (le : α → α → Bo | liftBind op cont ih => cases op with | cmpLE x y => - simp [traceSort, ih, Nat.add_comm] + simpa [traceSort, Nat.add_comm] using ih (le x y) /-- If two runs of a program have the same comparison transcript, then they have the same output. @@ -270,11 +280,9 @@ lemma hDecisionTreeLower (hCorrect : ∀ σ : Equiv.Perm (Fin n), P.eval (sortModelNat (permLE σ)) = permOutput σ) : Nat.factorial n ≤ 2 ^ worstTime P := by - have hCard : - Fintype.card (Equiv.Perm (Fin n)) ≤ 2 ^ worstTime P := - hDecisionTreeFintype (β := Equiv.Perm (Fin n)) (worstTime P) (traceCode P) - (traceCode_injective P hCorrect) - simpa [Fintype.card_perm] using hCard + simpa [Fintype.card_perm] using + (hDecisionTreeFintype (β := Equiv.Perm (Fin n)) (worstTime P) (traceCode P) + (traceCode_injective P hCorrect)) lemma eval_pairwise_of_correct {n : ℕ} (P : Prog (SortOps (Fin n)) (List (Fin n))) @@ -295,12 +303,7 @@ theorem cmpSort_lower_bound worstTime P ≥ (n / 2) * Nat.log 2 (n / 2) := by have hDecision : Nat.factorial n ≤ 2 ^ worstTime P := hDecisionTreeLower P hCorrect - have hLog : - Nat.log 2 (Nat.factorial n) ≤ Nat.log 2 (2 ^ worstTime P) := - Nat.log_mono_right hDecision - have hTime : Nat.log 2 (Nat.factorial n) ≤ worstTime P := by - simpa [Nat.log_pow (b := 2) (x := worstTime P) (by decide : 1 < 2)] using hLog - exact le_trans (hFactorialLog n) hTime + exact lowerBound_of_factorial_le_pow n (worstTime P) hDecision section HiddenOrderEquiv @@ -375,11 +378,9 @@ lemma hDecisionTreeLowerEquiv (hCorrect : ∀ σ : Equiv.Perm (Fin n), Prog.eval P (sortModelNat (α := β) (permLEEquiv e σ)) = permOutputEquiv e σ) : Nat.factorial n ≤ 2 ^ worstTimeEquiv e P := by - have hCard : - Fintype.card (Equiv.Perm (Fin n)) ≤ 2 ^ worstTimeEquiv e P := - hDecisionTreeFintype (β := Equiv.Perm (Fin n)) (worstTimeEquiv e P) (traceCodeEquiv e P) - (traceCodeEquiv_injective e P hCorrect) - simpa [Fintype.card_perm] using hCard + simpa [Fintype.card_perm] using + (hDecisionTreeFintype (β := Equiv.Perm (Fin n)) (worstTimeEquiv e P) (traceCodeEquiv e P) + (traceCodeEquiv_injective e P hCorrect)) /-- `Ω(n log n)` lower bound on any type equivalent to `Fin n`. -/ theorem cmpSort_lower_bound_equiv @@ -390,12 +391,7 @@ theorem cmpSort_lower_bound_equiv worstTimeEquiv e P ≥ (n / 2) * Nat.log 2 (n / 2) := by have hDecision : Nat.factorial n ≤ 2 ^ worstTimeEquiv e P := hDecisionTreeLowerEquiv e P hCorrect - have hLog : - Nat.log 2 (Nat.factorial n) ≤ Nat.log 2 (2 ^ worstTimeEquiv e P) := - Nat.log_mono_right hDecision - have hTime : Nat.log 2 (Nat.factorial n) ≤ worstTimeEquiv e P := by - simpa [Nat.log_pow (b := 2) (x := worstTimeEquiv e P) (by decide : 1 < 2)] using hLog - exact le_trans (hFactorialLog n) hTime + exact lowerBound_of_factorial_le_pow n (worstTimeEquiv e P) hDecision /-- `Ω(n log n)` lower bound stated directly for a finite carrier type `α`. -/ theorem cmpSort_lower_bound_fintype @@ -426,6 +422,219 @@ theorem cmpSort_lower_bound_infinite_types end HiddenOrderEquiv +section HiddenModelFamily + +/-! +## Hidden model family lower bounds + +This section develops the decision-tree lower bound in a model-parametric style: +the hidden input is a finite family of `SortOps` models (or equivalently a finite +family of comparators) satisfying order laws and unit comparison cost. +-/ + +/-- Comparator extracted from an arbitrary `SortOps` model. -/ +def modelLE (M : Model (SortOps α) ℕ) : α → α → Bool := + fun x y => M.evalQuery (SortOps.cmpLE x y) + +/-- Order laws for a finite family of Boolean comparators. -/ +structure ComparatorLawsFamily {ι α : Type*} (le : ι → α → α → Bool) : Prop where + total : ∀ i, Std.Total (fun x y => le i x y = true) + trans : ∀ i, IsTrans α (fun x y => le i x y = true) + +/-- Laws required for a finite hidden family of `SortOps` models. -/ +structure ModelLawsFamily {ι α : Type*} + (models : ι → Model (SortOps α) ℕ) : Prop where + unitCost : ∀ i x y, (models i).cost (SortOps.cmpLE x y) = 1 + cmpLaws : ComparatorLawsFamily (fun i => modelLE (models i)) + +lemma modelLawsFamily_sortModelNat + {ι α : Type*} {le : ι → α → α → Bool} + (hLaws : ComparatorLawsFamily le) : + ModelLawsFamily (fun i => sortModelNat (le i)) := by + refine ⟨?_, ⟨?_, ?_⟩⟩ + · intro i x y + grind [sortModelNat] + · intro i + simpa [modelLE, sortModelNat] using hLaws.total i + · intro i + simpa [modelLE, sortModelNat] using hLaws.trans i + +lemma eval_eq_eval_sortModelNat_modelLE + (P : Prog (SortOps α) β) (M : Model (SortOps α) ℕ) : + P.eval M = P.eval (sortModelNat (modelLE M)) := by + induction P with + | pure a => + simp + | liftBind op cont ih => + cases op with + | cmpLE x y => + simpa [Prog.eval_liftBind, modelLE, sortModelNat] using ih (modelLE M x y) + +lemma time_eq_time_sortModelNat_modelLE + (P : Prog (SortOps α) β) (M : Model (SortOps α) ℕ) + (hCost : ∀ x y, M.cost (SortOps.cmpLE x y) = 1) : + P.time M = P.time (sortModelNat (modelLE M)) := by + induction P with + | pure a => + simp + | liftBind op cont ih => + cases op with + | cmpLE x y => + simpa [Prog.time_liftBind, modelLE, sortModelNat, hCost x y] using + ih (modelLE M x y) + +lemma traceSort_length_eq_time_model + (P : Prog (SortOps α) β) (M : Model (SortOps α) ℕ) + (hCost : ∀ x y, M.cost (SortOps.cmpLE x y) = 1) : + (traceSort P (modelLE M)).length = P.time M := by + calc + (traceSort P (modelLE M)).length = P.time (sortModelNat (modelLE M)) := + traceSort_length_eq_time P (modelLE M) + _ = P.time M := (time_eq_time_sortModelNat_modelLE P M hCost).symm + +/-- Worst-case comparisons over a finite hidden family of `SortOps` models. -/ +def worstTimeModel {ι : Type*} [Fintype ι] + (models : ι → Model (SortOps α) ℕ) + (P : Prog (SortOps α) (List α)) : ℕ := + (Finset.univ : Finset ι).sup (fun i => P.time (models i)) + +/-- Fixed-length transcript code at depth `worstTimeModel`. -/ +def traceCodeModel {ι : Type*} [Fintype ι] + (models : ι → Model (SortOps α) ℕ) + (P : Prog (SortOps α) (List α)) : + ι → (Fin (worstTimeModel models P) → Bool) := + fun i => padTrace (worstTimeModel models P) (traceSort P (modelLE (models i))) + +lemma traceCodeModel_injective + {ι : Type*} [Fintype ι] + (models : ι → Model (SortOps α) ℕ) + (hCost : ∀ i x y, (models i).cost (SortOps.cmpLE x y) = 1) + (P : Prog (SortOps α) (List α)) + (output : ι → List α) + (hOutputInj : Function.Injective output) + (hCorrect : ∀ i, P.eval (models i) = output i) : + Function.Injective (traceCodeModel models P) := by + intro i j hCode + have hTimei : + P.time (models i) ≤ + (Finset.univ : Finset ι).sup (fun k => P.time (models k)) := by + exact Finset.le_sup + (s := (Finset.univ : Finset ι)) + (f := fun k => P.time (models k)) + (Finset.mem_univ i) + have hTimej : + P.time (models j) ≤ + (Finset.univ : Finset ι).sup (fun k => P.time (models k)) := by + exact Finset.le_sup + (s := (Finset.univ : Finset ι)) + (f := fun k => P.time (models k)) + (Finset.mem_univ j) + have hLeni : (traceSort P (modelLE (models i))).length ≤ worstTimeModel models P := by + simpa [worstTimeModel, traceSort_length_eq_time_model, hCost i] using hTimei + have hLenj : (traceSort P (modelLE (models j))).length ≤ worstTimeModel models P := by + simpa [worstTimeModel, traceSort_length_eq_time_model, hCost j] using hTimej + have hTrace : + traceSort P (modelLE (models i)) = traceSort P (modelLE (models j)) := by + exact traceSort_eq_of_padTrace_eq P hLeni hLenj hCode + have hEvalSortModel : + P.eval (sortModelNat (modelLE (models i))) = + P.eval (sortModelNat (modelLE (models j))) := + eval_eq_of_traceSort_eq P hTrace + have hEval : + P.eval (models i) = P.eval (models j) := by + calc + P.eval (models i) = P.eval (sortModelNat (modelLE (models i))) := + eval_eq_eval_sortModelNat_modelLE P (models i) + _ = P.eval (sortModelNat (modelLE (models j))) := hEvalSortModel + _ = P.eval (models j) := + (eval_eq_eval_sortModelNat_modelLE P (models j)).symm + have hOut : output i = output j := by + simpa [hCorrect i, hCorrect j] using hEval + exact hOutputInj hOut + +/-- +Decision-tree lower bound over an arbitrary finite hidden family of unit-cost +comparison models. +-/ +lemma hDecisionTreeLowerModel + {ι : Type*} [Fintype ι] + (models : ι → Model (SortOps α) ℕ) + (hLaws : ModelLawsFamily models) + (P : Prog (SortOps α) (List α)) + (output : ι → List α) + (hOutputInj : Function.Injective output) + (hCorrect : ∀ i, P.eval (models i) = output i) : + Fintype.card ι ≤ 2 ^ worstTimeModel models P := by + simpa using hDecisionTreeFintype (β := ι) (worstTimeModel models P) (traceCodeModel models P) + (traceCodeModel_injective models hLaws.unitCost P output hOutputInj hCorrect) + +/-- +`Ω(n log n)` lower bound from any hidden model family of size at least `n!`. + +This formulation is model-parametric: the hidden instances are full `SortOps` +models, not only permutation-induced comparators. +-/ +theorem cmpSort_lower_bound_model + {ι : Type*} [Fintype ι] + (n : ℕ) + (models : ι → Model (SortOps α) ℕ) + (hLaws : ModelLawsFamily models) + (P : Prog (SortOps α) (List α)) + (output : ι → List α) + (hOutputInj : Function.Injective output) + (hCorrect : ∀ i, P.eval (models i) = output i) + (hCard : Nat.factorial n ≤ Fintype.card ι) : + worstTimeModel models P ≥ (n / 2) * Nat.log 2 (n / 2) := by + have hDecisionFamily : Fintype.card ι ≤ 2 ^ worstTimeModel models P := + hDecisionTreeLowerModel models hLaws P output hOutputInj hCorrect + have hDecision : Nat.factorial n ≤ 2 ^ worstTimeModel models P := + le_trans hCard hDecisionFamily + exact lowerBound_of_factorial_le_pow n (worstTimeModel models P) hDecision + +/-- +If program evaluations are injective across hidden comparators, then any pointwise +equal output specification is injective as well. +-/ +lemma output_injective_of_eval_injective + {ι : Type*} + (le : ι → α → α → Bool) + (P : Prog (SortOps α) (List α)) + (output : ι → List α) + (hCorrect : ∀ i, P.eval (sortModelNat (le i)) = output i) + (hEvalInj : Function.Injective (fun i => P.eval (sortModelNat (le i)))) : + Function.Injective output := by + intro i j hEq + apply hEvalInj + grind + +/-- Correctness witness for a hidden family of comparators used in the lower bound. -/ +structure LeFamilyCorrectness {ι α : Type*} + (evalF : ι → List α) where + output : ι → List α + correct : ∀ i : ι, evalF i = output i + evalInj : Function.Injective evalF + +/-- +Comparator-family formulation: hidden instances are given directly as `le i`. +-/ +theorem cmpSort_lower_bound_le_family + {ι : Type*} [Fintype ι] + (n : ℕ) + (le : ι → α → α → Bool) + (hLaws : ComparatorLawsFamily le) + (P : Prog (SortOps α) (List α)) + (hSpec : LeFamilyCorrectness (fun i => P.eval (sortModelNat (le i)))) + (hCard : Nat.factorial n ≤ Fintype.card ι) : + worstTimeModel (fun i => sortModelNat (le i)) P ≥ + (n / 2) * Nat.log 2 (n / 2) := by + have hOutputInj : Function.Injective hSpec.output := by + exact output_injective_of_eval_injective le P hSpec.output hSpec.correct hSpec.evalInj + refine cmpSort_lower_bound_model (n := n) (models := fun i => sortModelNat (le i)) + (hLaws := modelLawsFamily_sortModelNat hLaws) + (P := P) (output := hSpec.output) hOutputInj hSpec.correct hCard + +end HiddenModelFamily + end Algorithms end Cslib From e7c8bdebd896240fe449d0235626ddd25ef10441 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Mar 2026 00:10:21 +0100 Subject: [PATCH 34/75] Clean up --- .../LowerBounds/ComparisonSort.lean | 84 ++++++++++--------- 1 file changed, 44 insertions(+), 40 deletions(-) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index b214bea2a..8fab0f951 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -447,17 +447,22 @@ structure ModelLawsFamily {ι α : Type*} unitCost : ∀ i x y, (models i).cost (SortOps.cmpLE x y) = 1 cmpLaws : ComparatorLawsFamily (fun i => modelLE (models i)) -lemma modelLawsFamily_sortModelNat +/-- +sortModelNats obey the model family laws and can therefore be instantiated +to the modelLawsFamily structure. +-/ +def modelLawsFamily_sortModelNat {ι α : Type*} {le : ι → α → α → Bool} (hLaws : ComparatorLawsFamily le) : - ModelLawsFamily (fun i => sortModelNat (le i)) := by - refine ⟨?_, ⟨?_, ?_⟩⟩ - · intro i x y + ModelLawsFamily (fun i => sortModelNat (le i)) where + unitCost := fun i x y => by grind [sortModelNat] - · intro i - simpa [modelLE, sortModelNat] using hLaws.total i - · intro i - simpa [modelLE, sortModelNat] using hLaws.trans i + cmpLaws := { + total := fun i => by + simpa [modelLE, sortModelNat] using hLaws.total i + trans := fun i => by + simpa [modelLE, sortModelNat] using hLaws.trans i + } lemma eval_eq_eval_sortModelNat_modelLE (P : Prog (SortOps α) β) (M : Model (SortOps α) ℕ) : @@ -515,42 +520,30 @@ lemma traceCodeModel_injective (hCorrect : ∀ i, P.eval (models i) = output i) : Function.Injective (traceCodeModel models P) := by intro i j hCode - have hTimei : - P.time (models i) ≤ - (Finset.univ : Finset ι).sup (fun k => P.time (models k)) := by - exact Finset.le_sup - (s := (Finset.univ : Finset ι)) - (f := fun k => P.time (models k)) - (Finset.mem_univ i) - have hTimej : - P.time (models j) ≤ - (Finset.univ : Finset ι).sup (fun k => P.time (models k)) := by - exact Finset.le_sup - (s := (Finset.univ : Finset ι)) - (f := fun k => P.time (models k)) - (Finset.mem_univ j) - have hLeni : (traceSort P (modelLE (models i))).length ≤ worstTimeModel models P := by - simpa [worstTimeModel, traceSort_length_eq_time_model, hCost i] using hTimei - have hLenj : (traceSort P (modelLE (models j))).length ≤ worstTimeModel models P := by - simpa [worstTimeModel, traceSort_length_eq_time_model, hCost j] using hTimej + have hLen (ρ : ι) : + (traceSort P (modelLE (models ρ))).length ≤ worstTimeModel models P := by + have hTimeρ : + P.time (models ρ) ≤ + (Finset.univ : Finset ι).sup (fun k => P.time (models k)) := by + exact Finset.le_sup + (s := (Finset.univ : Finset ι)) + (f := fun k => P.time (models k)) + (Finset.mem_univ ρ) + grind [worstTimeModel, traceSort_length_eq_time_model, hCost ρ] have hTrace : traceSort P (modelLE (models i)) = traceSort P (modelLE (models j)) := by - exact traceSort_eq_of_padTrace_eq P hLeni hLenj hCode - have hEvalSortModel : - P.eval (sortModelNat (modelLE (models i))) = - P.eval (sortModelNat (modelLE (models j))) := - eval_eq_of_traceSort_eq P hTrace + exact traceSort_eq_of_padTrace_eq P (hLen i) (hLen j) hCode have hEval : P.eval (models i) = P.eval (models j) := by calc P.eval (models i) = P.eval (sortModelNat (modelLE (models i))) := eval_eq_eval_sortModelNat_modelLE P (models i) - _ = P.eval (sortModelNat (modelLE (models j))) := hEvalSortModel + _ = P.eval (sortModelNat (modelLE (models j))) := + eval_eq_of_traceSort_eq P hTrace _ = P.eval (models j) := (eval_eq_eval_sortModelNat_modelLE P (models j)).symm - have hOut : output i = output j := by - simpa [hCorrect i, hCorrect j] using hEval - exact hOutputInj hOut + exact hOutputInj <| by + aesop (add simp [hCorrect, hEval]) /-- Decision-tree lower bound over an arbitrary finite hidden family of unit-cost @@ -569,12 +562,13 @@ lemma hDecisionTreeLowerModel (traceCodeModel_injective models hLaws.unitCost P output hOutputInj hCorrect) /-- -`Ω(n log n)` lower bound from any hidden model family of size at least `n!`. +We prove the cardinality assumption used in this lemma in +`factorial_le_card_of_orderEmbedding` below. This formulation is model-parametric: the hidden instances are full `SortOps` models, not only permutation-induced comparators. -/ -theorem cmpSort_lower_bound_model +lemma cmpSort_lower_bound_model {ι : Type*} [Fintype ι] (n : ℕ) (models : ι → Model (SortOps α) ℕ) @@ -609,12 +603,21 @@ lemma output_injective_of_eval_injective /-- Correctness witness for a hidden family of comparators used in the lower bound. -/ structure LeFamilyCorrectness {ι α : Type*} - (evalF : ι → List α) where + (n : ℕ) (evalF : ι → List α) where output : ι → List α correct : ∀ i : ι, evalF i = output i evalInj : Function.Injective evalF + orderEmbedding : Equiv.Perm (Fin n) ↪ ι + +lemma factorial_le_card_of_orderEmbedding + {ι : Type*} [Fintype ι] (n : ℕ) (emb : Equiv.Perm (Fin n) ↪ ι) : + Nat.factorial n ≤ Fintype.card ι := by + have hCardPerm : Fintype.card (Equiv.Perm (Fin n)) ≤ Fintype.card ι := + Fintype.card_le_of_injective emb emb.injective + simpa [Fintype.card_perm] using hCardPerm /-- +`Ω(n log n)` lower bound from any hidden model family. Comparator-family formulation: hidden instances are given directly as `le i`. -/ theorem cmpSort_lower_bound_le_family @@ -623,10 +626,11 @@ theorem cmpSort_lower_bound_le_family (le : ι → α → α → Bool) (hLaws : ComparatorLawsFamily le) (P : Prog (SortOps α) (List α)) - (hSpec : LeFamilyCorrectness (fun i => P.eval (sortModelNat (le i)))) - (hCard : Nat.factorial n ≤ Fintype.card ι) : + (hSpec : LeFamilyCorrectness n (fun i => P.eval (sortModelNat (le i)))) : worstTimeModel (fun i => sortModelNat (le i)) P ≥ (n / 2) * Nat.log 2 (n / 2) := by + have hCard : Nat.factorial n ≤ Fintype.card ι := + factorial_le_card_of_orderEmbedding n hSpec.orderEmbedding have hOutputInj : Function.Injective hSpec.output := by exact output_injective_of_eval_injective le P hSpec.output hSpec.correct hSpec.evalInj refine cmpSort_lower_bound_model (n := n) (models := fun i => sortModelNat (le i)) From a8e9f3d6114923935e624827ec73469811589554 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Mar 2026 00:17:13 +0100 Subject: [PATCH 35/75] Clean up a bit --- .../LowerBounds/ComparisonSort.lean | 114 +++++++----------- 1 file changed, 46 insertions(+), 68 deletions(-) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index 8fab0f951..0e67b3fdb 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -225,51 +225,55 @@ lemma traceSort_eq_of_padTrace_eq exact traceSort_prefix_eq P (isPrefix_of_padTrace_eq hLen₂ hcmp' hPad.symm) exact hEq21.symm +/-- Worst-case comparisons over a finite hidden family of comparators. -/ +def worstTimeComp {ι : Type*} [Fintype ι] + (P : Prog (SortOps α) (List α)) (leF : ι → α → α → Bool) : ℕ := + (Finset.univ : Finset ι).sup (fun i => P.time (sortModelNat (leF i))) + +/-- Fixed-length transcript code at depth `worstTimeComp`. -/ +def traceCodeComp {ι : Type*} [Fintype ι] + (P : Prog (SortOps α) (List α)) (leF : ι → α → α → Bool) : + ι → (Fin (worstTimeComp P leF) → Bool) := + fun i => padTrace (worstTimeComp P leF) (traceSort P (leF i)) + +lemma traceCodeComp_injective + {ι : Type*} [Fintype ι] + (P : Prog (SortOps α) (List α)) (leF : ι → α → α → Bool) + (output : ι → List α) + (hOutputInj : Function.Injective output) + (hCorrect : ∀ i, P.eval (sortModelNat (leF i)) = output i) : + Function.Injective (traceCodeComp P leF) := by + intro i j hCode + have hLen (ρ : ι) : + (traceSort P (leF ρ)).length ≤ worstTimeComp P leF := by + simpa [worstTimeComp, traceSort_length_eq_time] using + (Finset.le_sup + (s := (Finset.univ : Finset ι)) + (f := fun k => P.time (sortModelNat (leF k))) + (Finset.mem_univ ρ)) + have hTrace : + traceSort P (leF i) = traceSort P (leF j) := by + exact traceSort_eq_of_padTrace_eq P (hLen i) (hLen j) hCode + exact hOutputInj <| by + simpa [hCorrect i, hCorrect j] using eval_eq_of_traceSort_eq P hTrace + /-- Worst-case number of comparisons over all hidden permutations of `Fin n`. -/ -def worstTime {n : ℕ} (P : Prog (SortOps (Fin n)) (List (Fin n))) : ℕ := - (Finset.univ : Finset (Equiv.Perm (Fin n))).sup - (fun σ => P.time (sortModelNat (permLE σ))) +abbrev worstTime {n : ℕ} (P : Prog (SortOps (Fin n)) (List (Fin n))) : ℕ := + worstTimeComp P (fun σ => permLE σ) /-- Fixed-length transcript code at depth `worstTime`. -/ -def traceCode {n : ℕ} (P : Prog (SortOps (Fin n)) (List (Fin n))) : +abbrev traceCode {n : ℕ} (P : Prog (SortOps (Fin n)) (List (Fin n))) : Equiv.Perm (Fin n) → (Fin (worstTime P) → Bool) := - fun σ => padTrace (worstTime P) (traceSort P (permLE σ)) + traceCodeComp P (fun σ => permLE σ) lemma traceCode_injective {n : ℕ} (P : Prog (SortOps (Fin n)) (List (Fin n))) (hCorrect : ∀ σ : Equiv.Perm (Fin n), P.eval (sortModelNat (permLE σ)) = permOutput σ) : Function.Injective (traceCode P) := by - intro σ τ hCode - have hTimeσ : - P.time (sortModelNat (permLE σ)) ≤ - (Finset.univ : Finset (Equiv.Perm (Fin n))).sup - (fun ρ => P.time (sortModelNat (permLE ρ))) := by - exact Finset.le_sup - (s := (Finset.univ : Finset (Equiv.Perm (Fin n)))) - (f := fun ρ => P.time (sortModelNat (permLE ρ))) - (Finset.mem_univ σ) - have hTimeτ : - P.time (sortModelNat (permLE τ)) ≤ - (Finset.univ : Finset (Equiv.Perm (Fin n))).sup - (fun ρ => P.time (sortModelNat (permLE ρ))) := by - exact Finset.le_sup - (s := (Finset.univ : Finset (Equiv.Perm (Fin n)))) - (f := fun ρ => P.time (sortModelNat (permLE ρ))) - (Finset.mem_univ τ) - have hLenσ : (traceSort P (permLE σ)).length ≤ worstTime P := by - simpa [worstTime, traceSort_length_eq_time] using hTimeσ - have hLenτ : (traceSort P (permLE τ)).length ≤ worstTime P := by - simpa [worstTime, traceSort_length_eq_time] using hTimeτ - have hTrace : - traceSort P (permLE σ) = traceSort P (permLE τ) := by - exact traceSort_eq_of_padTrace_eq P hLenσ hLenτ hCode - have hEval : - P.eval (sortModelNat (permLE σ)) = P.eval (sortModelNat (permLE τ)) := - eval_eq_of_traceSort_eq P hTrace - have hOut : permOutput σ = permOutput τ := by - simpa [hCorrect σ, hCorrect τ] using hEval - exact permOutput_injective hOut + simpa [traceCode, worstTime] using + (traceCodeComp_injective P (fun σ => permLE σ) (permOutput (n := n)) + (permOutput_injective (n := n)) hCorrect) /-- Decision-tree lower bound in the strong hidden-permutation model: @@ -284,14 +288,6 @@ lemma hDecisionTreeLower (hDecisionTreeFintype (β := Equiv.Perm (Fin n)) (worstTime P) (traceCode P) (traceCode_injective P hCorrect)) -lemma eval_pairwise_of_correct - {n : ℕ} (P : Prog (SortOps (Fin n)) (List (Fin n))) - (hCorrect : ∀ σ : Equiv.Perm (Fin n), - P.eval (sortModelNat (permLE σ)) = permOutput σ) - (σ : Equiv.Perm (Fin n)) : - (P.eval (sortModelNat (permLE σ))).Pairwise (fun x y => permLE σ x y = true) := by - simpa [hCorrect σ] using permOutput_pairwise σ - /-- GPT suggested to pick an abitrary hidden permutation of `Fin n` and generate a list from it and then prove that for this, sorting takes `n /2 * (Nat.log 2 (n / 2))` @@ -317,13 +313,6 @@ def permOutputEquiv {β : Type} {n : ℕ} (e : β ≃ Fin n) (σ : Equiv.Perm (Fin n)) : List β := List.ofFn (fun i => e.symm (σ.symm i)) -lemma permOutputEquiv_pairwise {β : Type} {n : ℕ} - (e : β ≃ Fin n) (σ : Equiv.Perm (Fin n)) : - (permOutputEquiv e σ).Pairwise (fun x y => permLEEquiv e σ x y = true) := by - rw [permOutputEquiv, List.pairwise_ofFn] - intro i j hij - simpa [permLEEquiv, decide_eq_true_eq] using (le_of_lt hij) - lemma permOutputEquiv_injective {β : Type} {n : ℕ} (e : β ≃ Fin n) : Function.Injective (permOutputEquiv e) := by @@ -341,16 +330,15 @@ lemma permOutputEquiv_injective {β : Type} {n : ℕ} simpa [eq_comm] using congrArg Fin.val hσ /-- Worst-case comparisons over hidden permutations, transported through `e`. -/ -def worstTimeEquiv {β : Type} {n : ℕ} +abbrev worstTimeEquiv {β : Type} {n : ℕ} (e : β ≃ Fin n) (P : Prog (SortOps β) (List β)) : ℕ := - (Finset.univ : Finset (Equiv.Perm (Fin n))).sup - (fun σ => Prog.time P (sortModelNat (α := β) (permLEEquiv e σ))) + worstTimeComp P (fun σ => permLEEquiv e σ) /-- Fixed-length transcript code at depth `worstTimeEquiv`. -/ -def traceCodeEquiv {β : Type} {n : ℕ} +abbrev traceCodeEquiv {β : Type} {n : ℕ} (e : β ≃ Fin n) (P : Prog (SortOps β) (List β)) : Equiv.Perm (Fin n) → (Fin (worstTimeEquiv e P) → Bool) := - fun σ => padTrace (worstTimeEquiv e P) (traceSort P (permLEEquiv e σ)) + traceCodeComp P (fun σ => permLEEquiv e σ) lemma traceCodeEquiv_injective {β : Type} {n : ℕ} @@ -358,19 +346,9 @@ lemma traceCodeEquiv_injective (hCorrect : ∀ σ : Equiv.Perm (Fin n), Prog.eval P (sortModelNat (α := β) (permLEEquiv e σ)) = permOutputEquiv e σ) : Function.Injective (traceCodeEquiv e P) := by - intro σ τ hCode - have hLen (ρ : Equiv.Perm (Fin n)) : - (traceSort P (permLEEquiv e ρ)).length ≤ worstTimeEquiv e P := by - simpa [worstTimeEquiv, traceSort_length_eq_time] using - (Finset.le_sup - (s := (Finset.univ : Finset (Equiv.Perm (Fin n)))) - (f := fun ρ => Prog.time P (sortModelNat (α := β) (permLEEquiv e ρ))) - (Finset.mem_univ ρ)) - have hTrace : - traceSort P (permLEEquiv e σ) = traceSort P (permLEEquiv e τ) := by - exact traceSort_eq_of_padTrace_eq P (hLen σ) (hLen τ) hCode - exact permOutputEquiv_injective e <| by - simpa [hCorrect σ, hCorrect τ] using eval_eq_of_traceSort_eq P hTrace + simpa [traceCodeEquiv, worstTimeEquiv] using + (traceCodeComp_injective P (fun σ => permLEEquiv e σ) (permOutputEquiv e) + (permOutputEquiv_injective e) hCorrect) lemma hDecisionTreeLowerEquiv {β : Type} {n : ℕ} From 30cf281c16e00f65bee35844d10af51d69071aaf Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Mar 2026 00:32:43 +0100 Subject: [PATCH 36/75] Remove Prop from structure --- Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index 0e67b3fdb..7a43cb166 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -421,7 +421,7 @@ structure ComparatorLawsFamily {ι α : Type*} (le : ι → α → α → Bool) /-- Laws required for a finite hidden family of `SortOps` models. -/ structure ModelLawsFamily {ι α : Type*} - (models : ι → Model (SortOps α) ℕ) : Prop where + (models : ι → Model (SortOps α) ℕ) where unitCost : ∀ i x y, (models i).cost (SortOps.cmpLE x y) = 1 cmpLaws : ComparatorLawsFamily (fun i => modelLE (models i)) From a145ded53d01e24f58f982421b8631c10cd326a6 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Mar 2026 00:34:27 +0100 Subject: [PATCH 37/75] docstring --- Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index 7a43cb166..26f89fed1 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -582,9 +582,11 @@ lemma output_injective_of_eval_injective /-- Correctness witness for a hidden family of comparators used in the lower bound. -/ structure LeFamilyCorrectness {ι α : Type*} (n : ℕ) (evalF : ι → List α) where + /-- The output list -/ output : ι → List α correct : ∀ i : ι, evalF i = output i evalInj : Function.Injective evalF + /-- The embedding of a permutation on n elements into ι -/ orderEmbedding : Equiv.Perm (Fin n) ↪ ι lemma factorial_le_card_of_orderEmbedding From c6e1addea9e1b5b7d8de37cfcd2118a39022c413 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Mar 2026 00:36:55 +0100 Subject: [PATCH 38/75] Where did prop typed structures sneak in. Purge them --- Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index 26f89fed1..f59caf7fc 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -415,7 +415,7 @@ def modelLE (M : Model (SortOps α) ℕ) : α → α → Bool := fun x y => M.evalQuery (SortOps.cmpLE x y) /-- Order laws for a finite family of Boolean comparators. -/ -structure ComparatorLawsFamily {ι α : Type*} (le : ι → α → α → Bool) : Prop where +structure ComparatorLawsFamily {ι α : Type*} (le : ι → α → α → Bool) where total : ∀ i, Std.Total (fun x y => le i x y = true) trans : ∀ i, IsTrans α (fun x y => le i x y = true) From e07de01a02234fdcb78d211242bbea2f9c030823 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Mar 2026 00:42:43 +0100 Subject: [PATCH 39/75] Where did prop typed structures sneak in. Purge them --- Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index f59caf7fc..e871f57bc 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -415,13 +415,13 @@ def modelLE (M : Model (SortOps α) ℕ) : α → α → Bool := fun x y => M.evalQuery (SortOps.cmpLE x y) /-- Order laws for a finite family of Boolean comparators. -/ -structure ComparatorLawsFamily {ι α : Type*} (le : ι → α → α → Bool) where +structure ComparatorLawsFamily {ι α : Type*} (le : ι → α → α → Bool) : Type where total : ∀ i, Std.Total (fun x y => le i x y = true) trans : ∀ i, IsTrans α (fun x y => le i x y = true) /-- Laws required for a finite hidden family of `SortOps` models. -/ structure ModelLawsFamily {ι α : Type*} - (models : ι → Model (SortOps α) ℕ) where + (models : ι → Model (SortOps α) ℕ) : Type where unitCost : ∀ i x y, (models i).cost (SortOps.cmpLE x y) = 1 cmpLaws : ComparatorLawsFamily (fun i => modelLE (models i)) From cf9f1f53d73c5a65baaa9b302ce28ef2469edfdc Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Mar 2026 01:07:34 +0100 Subject: [PATCH 40/75] Fix lint --- .../LowerBounds/ComparisonSort.lean | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean index e871f57bc..078e559fe 100644 --- a/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/LowerBounds/ComparisonSort.lean @@ -415,13 +415,13 @@ def modelLE (M : Model (SortOps α) ℕ) : α → α → Bool := fun x y => M.evalQuery (SortOps.cmpLE x y) /-- Order laws for a finite family of Boolean comparators. -/ -structure ComparatorLawsFamily {ι α : Type*} (le : ι → α → α → Bool) : Type where +structure ComparatorLawsFamily {ι α : Type*} (le : ι → α → α → Bool) where total : ∀ i, Std.Total (fun x y => le i x y = true) trans : ∀ i, IsTrans α (fun x y => le i x y = true) /-- Laws required for a finite hidden family of `SortOps` models. -/ structure ModelLawsFamily {ι α : Type*} - (models : ι → Model (SortOps α) ℕ) : Type where + (models : ι → Model (SortOps α) ℕ) where unitCost : ∀ i x y, (models i).cost (SortOps.cmpLE x y) = 1 cmpLaws : ComparatorLawsFamily (fun i => modelLE (models i)) @@ -429,18 +429,17 @@ structure ModelLawsFamily {ι α : Type*} sortModelNats obey the model family laws and can therefore be instantiated to the modelLawsFamily structure. -/ -def modelLawsFamily_sortModelNat +lemma modelLawsFamily_sortModelNat {ι α : Type*} {le : ι → α → α → Bool} (hLaws : ComparatorLawsFamily le) : - ModelLawsFamily (fun i => sortModelNat (le i)) where - unitCost := fun i x y => by - grind [sortModelNat] - cmpLaws := { - total := fun i => by + ModelLawsFamily (fun i => sortModelNat (le i)) := by + refine ⟨?_, ⟨?_, ?_⟩⟩ + · intro i x y + grind [sortModelNat] + · intro i simpa [modelLE, sortModelNat] using hLaws.total i - trans := fun i => by + · intro i simpa [modelLE, sortModelNat] using hLaws.trans i - } lemma eval_eq_eval_sortModelNat_modelLE (P : Prog (SortOps α) β) (M : Model (SortOps α) ℕ) : From 56c98a507fdbca9916d6aa8f1321fe4212076133 Mon Sep 17 00:00:00 2001 From: Shrys Date: Thu, 19 Mar 2026 01:21:28 +0100 Subject: [PATCH 41/75] Fix documentation for listLinearSearch evaluation --- Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index 9c685886a..d46666da3 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -27,7 +27,7 @@ the `ListSearch` model. ## Main results -- `listLinearSearch_eval`: `insertOrd` evaluates identically to `List.contains`. +- `listLinearSearch_eval`: `listLinearSearch` evaluates identically to `List.contains`. - `listLinearSearchM_time_complexity_upper_bound` : `linearSearch` takes at most `n` comparison operations - `listLinearSearchM_time_complexity_lower_bound` : There exist lists on which `linearSearch` needs From 1fb24e1b5bbe7a452783570e9124d653269ab1a2 Mon Sep 17 00:00:00 2001 From: Shrys Date: Thu, 16 Apr 2026 10:09:45 +0200 Subject: [PATCH 42/75] Update ListComparisonSort.lean Co-authored-by: Ethan Ermovick <61568556+Arleee1@users.noreply.github.com> --- Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 4781fbf06..5634a51e1 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -43,7 +43,7 @@ A model for comparison sorting on lists. -/ inductive SortOpsInsertHead (α : Type) : Type → Type where /-- `cmpLE x y` is intended to return `true` if `x ≤ y` and `false` otherwise. - The specific order relation depends on the model provided for this typ. e-/ + The specific order relation depends on the model provided for this type. -/ | cmpLE (x : α) (y : α) : SortOpsInsertHead α Bool /-- `insertHead l x` is intended to return `x :: l`. -/ | insertHead (x : α) (l : List α) : SortOpsInsertHead α (List α) From 7ece1dd07e20e04a239e7245d1cf38cfef469872 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Thu, 5 Mar 2026 08:34:28 +0000 Subject: [PATCH 43/75] feat(Query): query complexity framework with sorting lower bound MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add a framework for proving upper and lower bounds on query complexity of comparison-based algorithms, using `Prog` (free monad over query types) with oracle-parametric evaluation and structural query counting. Results: - Insertion sort: correctness + O(n²) upper bound - Merge sort: correctness + n·⌈log₂ n⌉ upper bound - Lower bound: any correct comparison sort on an infinite type needs ≥ ⌈log₂(n!)⌉ queries (via adversarial pigeonhole on QueryTree depth) Co-Authored-By: Claude Opus 4.6 Co-authored-by: Shrys --- Cslib.lean | 11 + Cslib/Algorithms/Lean/Query/Bounds.lean | 37 +++ Cslib/Algorithms/Lean/Query/Prog.lean | 92 ++++++ Cslib/Algorithms/Lean/Query/QueryTree.lean | 140 +++++++++ .../Lean/Query/Sort/Insertion/Defs.lean | 41 +++ .../Lean/Query/Sort/Insertion/Lemmas.lean | 168 +++++++++++ Cslib/Algorithms/Lean/Query/Sort/IsSort.lean | 37 +++ Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean | 35 +++ .../Lean/Query/Sort/LowerBound.lean | 214 ++++++++++++++ .../Lean/Query/Sort/Merge/Defs.lean | 94 ++++++ .../Lean/Query/Sort/Merge/Lemmas.lean | 271 ++++++++++++++++++ .../Algorithms/Lean/Query/Sort/QueryTree.lean | 107 +++++++ 12 files changed, 1247 insertions(+) create mode 100644 Cslib/Algorithms/Lean/Query/Bounds.lean create mode 100644 Cslib/Algorithms/Lean/Query/Prog.lean create mode 100644 Cslib/Algorithms/Lean/Query/QueryTree.lean create mode 100644 Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean create mode 100644 Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean create mode 100644 Cslib/Algorithms/Lean/Query/Sort/IsSort.lean create mode 100644 Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean create mode 100644 Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean create mode 100644 Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean create mode 100644 Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean create mode 100644 Cslib/Algorithms/Lean/Query/Sort/QueryTree.lean diff --git a/Cslib.lean b/Cslib.lean index 7db43680b..ebc248025 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,6 +1,17 @@ module -- shake: keep-all public import Cslib.Algorithms.Lean.MergeSort.MergeSort +public import Cslib.Algorithms.Lean.Query.Bounds +public import Cslib.Algorithms.Lean.Query.Prog +public import Cslib.Algorithms.Lean.Query.QueryTree +public import Cslib.Algorithms.Lean.Query.Sort.Insertion.Defs +public import Cslib.Algorithms.Lean.Query.Sort.Insertion.Lemmas +public import Cslib.Algorithms.Lean.Query.Sort.IsSort +public import Cslib.Algorithms.Lean.Query.Sort.LEQuery +public import Cslib.Algorithms.Lean.Query.Sort.LowerBound +public import Cslib.Algorithms.Lean.Query.Sort.Merge.Defs +public import Cslib.Algorithms.Lean.Query.Sort.Merge.Lemmas +public import Cslib.Algorithms.Lean.Query.Sort.QueryTree public import Cslib.Algorithms.Lean.TimeM public import Cslib.Computability.Automata.Acceptors.Acceptor public import Cslib.Computability.Automata.Acceptors.OmegaAcceptor diff --git a/Cslib/Algorithms/Lean/Query/Bounds.lean b/Cslib/Algorithms/Lean/Query/Bounds.lean new file mode 100644 index 000000000..e679be1ec --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/Bounds.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sebastian Graf, Kim Morrison, Shreyas Srinivas +-/ +module + +public import Cslib.Algorithms.Lean.Query.Prog + +/-! # Upper and Lower Bounds for Query Complexity + +Definitions of upper and lower bounds on the number of queries a program makes, +quantified over oracles. +-/ + +open Cslib.Query + +public section + +namespace Cslib.Query + +/-- Upper bound: for all oracles, inputs of size ≤ n make at most `bound n` queries. -/ +@[expose] def UpperBound (prog : α → Prog Q β) + (size : α → Nat) (bound : Nat → Nat) : Prop := + ∀ (oracle : {ι : Type} → Q ι → ι) (n : Nat) (x : α), + size x ≤ n → (prog x).queriesOn oracle ≤ bound n + +/-- Lower bound: for every size n, there exists an input and oracle + making the program perform ≥ `bound n` queries. -/ +@[expose] def LowerBound (prog : α → Prog Q β) + (size : α → Nat) (bound : Nat → Nat) : Prop := + ∀ (n : Nat), ∃ (x : α), size x ≤ n ∧ + ∃ (oracle : {ι : Type} → Q ι → ι), bound n ≤ (prog x).queriesOn oracle + +end Cslib.Query + +end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Prog.lean b/Cslib/Algorithms/Lean/Query/Prog.lean new file mode 100644 index 000000000..d135ca491 --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/Prog.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sebastian Graf, Kim Morrison, Shreyas Srinivas +-/ +module + +public import Cslib.Foundations.Control.Monad.Free + +/-! # Prog: Programs as Free Monads over Query Types + +`Prog Q α` is an alias for `FreeM Q α`, representing a program that makes queries of type `Q` +and returns a result of type `α`. A query type `Q : Type → Type` maps each query to its +response type. + +The key operations are: +- `Prog.eval oracle p`: evaluate `p` by answering each query using `oracle` +- `Prog.queriesOn oracle p`: count the queries along the oracle-determined path + +Because the oracle is supplied *after* the program produces its query plan (the `Prog` tree), +a sound implementation of `prog` has no way to "guess" what the oracle would respond. +This is the foundation of the anti-cheating guarantee for both upper and lower bounds. + +This provides an alternative to the `TimeM`-based cost analysis in +`Cslib.Algorithms.Lean.MergeSort`: here query counting is structural (derived from the +`Prog` tree) rather than annotation-based. +-/ + +open Cslib + +public section + +namespace Cslib.Query + +/-- A program that makes queries of type `Q` and returns a result of type `α`. + This is `FreeM Q α`, the free monad over the query type. -/ +abbrev Prog (Q : Type → Type) (α : Type) := FreeM Q α + +namespace Prog + +variable {Q : Type → Type} {α β : Type} + +/-- Evaluate a program by answering each query using `oracle`. -/ +@[expose] def eval (oracle : {ι : Type} → Q ι → ι) : Prog Q α → α + | .pure a => a + | .liftBind op cont => eval oracle (cont (oracle op)) + +/-- Count the number of queries along the path determined by `oracle`. -/ +@[expose] def queriesOn (oracle : {ι : Type} → Q ι → ι) : Prog Q α → Nat + | .pure _ => 0 + | .liftBind op cont => 1 + queriesOn oracle (cont (oracle op)) + +-- Simp lemmas for eval + +@[simp] theorem eval_pure (oracle : {ι : Type} → Q ι → ι) (a : α) : + eval oracle (.pure a : Prog Q α) = a := rfl + +@[simp] theorem eval_liftBind (oracle : {ι : Type} → Q ι → ι) + {ι : Type} (op : Q ι) (cont : ι → Prog Q α) : + eval oracle (.liftBind op cont) = eval oracle (cont (oracle op)) := rfl + +@[simp] theorem eval_bind (oracle : {ι : Type} → Q ι → ι) + (t : Prog Q α) (f : α → Prog Q β) : + eval oracle (t.bind f) = eval oracle (f (eval oracle t)) := by + induction t with + | pure a => rfl + | liftBind op cont ih => exact ih (oracle op) + +-- Simp lemmas for queriesOn + +@[simp] theorem queriesOn_pure (oracle : {ι : Type} → Q ι → ι) (a : α) : + queriesOn oracle (.pure a : Prog Q α) = 0 := rfl + +@[simp] theorem queriesOn_liftBind (oracle : {ι : Type} → Q ι → ι) + {ι : Type} (op : Q ι) (cont : ι → Prog Q α) : + queriesOn oracle (.liftBind op cont) = 1 + queriesOn oracle (cont (oracle op)) := rfl + +@[simp] theorem queriesOn_bind (oracle : {ι : Type} → Q ι → ι) + (t : Prog Q α) (f : α → Prog Q β) : + queriesOn oracle (t.bind f) = + queriesOn oracle t + queriesOn oracle (f (eval oracle t)) := by + induction t with + | pure a => simp [FreeM.bind] + | liftBind op cont ih => + simp only [FreeM.bind, queriesOn_liftBind, eval_liftBind, ih (oracle op)] + omega + +end Prog + +end Cslib.Query + +end -- public section diff --git a/Cslib/Algorithms/Lean/Query/QueryTree.lean b/Cslib/Algorithms/Lean/Query/QueryTree.lean new file mode 100644 index 000000000..60db1768b --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/QueryTree.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sebastian Graf, Kim Morrison, Shreyas Srinivas +-/ +module + +public import Cslib.Init +public import Mathlib.Data.Nat.Log +public import Mathlib.Data.Fintype.Card + +/-! # QueryTree: Decision Trees for Query Complexity Lower Bounds + +`QueryTree Q R α` is a free monad specialized to a single query type: queries take +input `Q` and return `R`, with final results of type `α`. It reifies an algorithm's +query pattern as an explicit decision tree. + +The key advantage over `Prog`/`FreeM` for lower bound proofs is that `R` is a fixed type +parameter (not existentially quantified per query), making structural induction with +pigeonhole arguments straightforward. + +## Main Definitions + +- `QueryTree Q R α` — the decision tree type +- `QueryTree.ask` — the canonical single-query tree +- `QueryTree.eval` — evaluate with a specific oracle +- `QueryTree.queriesOn` — count queries along an oracle-determined path +-/ + +public section + +namespace Cslib.Query + +/-- A decision tree over queries of type `Q → R`, with results of type `α`. + +This is the free monad specialized to a single fixed-type operation, used to reify +algorithms as explicit trees for query complexity lower bounds. -/ +inductive QueryTree (Q : Type) (R : Type) (α : Type) where + /-- A completed computation returning value `a`. -/ + | pure (a : α) : QueryTree Q R α + /-- A query node: asks query `q`, then continues based on the response. -/ + | query (q : Q) (cont : R → QueryTree Q R α) : QueryTree Q R α + +namespace QueryTree + +variable {Q R α β γ : Type} + +/-- Lift a single query into the tree. -/ +@[expose] def ask (q : Q) : QueryTree Q R R := .query q .pure + +/-- Monadic bind for query trees. -/ +@[expose] protected def bind : QueryTree Q R α → (α → QueryTree Q R β) → QueryTree Q R β + | .pure a, f => f a + | .query q cont, f => .query q (fun r => (cont r).bind f) + +/-- Functorial map for query trees. -/ +@[expose] protected def map (f : α → β) : QueryTree Q R α → QueryTree Q R β + | .pure a => .pure (f a) + | .query q cont => .query q (fun r => (cont r).map f) + +protected theorem bind_pure : ∀ (x : QueryTree Q R α), x.bind .pure = x + | .pure _ => rfl + | .query _ cont => by simp [QueryTree.bind, QueryTree.bind_pure] + +protected theorem bind_assoc : + ∀ (x : QueryTree Q R α) (f : α → QueryTree Q R β) (g : β → QueryTree Q R γ), + (x.bind f).bind g = x.bind (fun a => (f a).bind g) + | .pure _, _, _ => rfl + | .query _ cont, f, g => by simp [QueryTree.bind, QueryTree.bind_assoc] + +protected theorem bind_pure_comp (f : α → β) : + ∀ (x : QueryTree Q R α), x.bind (.pure ∘ f) = x.map f + | .pure _ => rfl + | .query _ cont => by simp [QueryTree.bind, QueryTree.map, QueryTree.bind_pure_comp] + +protected theorem id_map : ∀ (x : QueryTree Q R α), x.map id = x + | .pure _ => rfl + | .query _ cont => by simp [QueryTree.map, QueryTree.id_map] + +instance : Monad (QueryTree Q R) where + pure := .pure + bind := .bind + +instance : LawfulMonad (QueryTree Q R) := LawfulMonad.mk' + (bind_pure_comp := fun _ _ => rfl) + (id_map := QueryTree.bind_pure) + (pure_bind := fun _ _ => rfl) + (bind_assoc := QueryTree.bind_assoc) + +-- Core operations + +/-- Evaluate a query tree with a specific oracle, returning the final result. -/ +@[expose] def eval (oracle : Q → R) : QueryTree Q R α → α + | .pure a => a + | .query q cont => eval oracle (cont (oracle q)) + +/-- Count the number of queries along the path determined by `oracle`. -/ +@[expose] def queriesOn (oracle : Q → R) : QueryTree Q R α → Nat + | .pure _ => 0 + | .query q cont => 1 + queriesOn oracle (cont (oracle q)) + +-- Simp lemmas + +@[simp] theorem eval_pure' (oracle : Q → R) (a : α) : + (QueryTree.pure a : QueryTree Q R α).eval oracle = a := rfl + +@[simp] theorem eval_query (oracle : Q → R) (q : Q) (cont : R → QueryTree Q R α) : + (QueryTree.query q cont).eval oracle = (cont (oracle q)).eval oracle := rfl + +@[simp] theorem eval_bind (oracle : Q → R) (t : QueryTree Q R α) (f : α → QueryTree Q R β) : + (t.bind f).eval oracle = (f (t.eval oracle)).eval oracle := by + induction t with + | pure a => rfl + | query q cont ih => exact ih (oracle q) + +@[simp] theorem queriesOn_pure' (oracle : Q → R) (a : α) : + (QueryTree.pure a : QueryTree Q R α).queriesOn oracle = 0 := rfl + +@[simp] theorem queriesOn_query (oracle : Q → R) (q : Q) (cont : R → QueryTree Q R α) : + (QueryTree.query q cont).queriesOn oracle = 1 + (cont (oracle q)).queriesOn oracle := rfl + +/-- Queries of `t.bind f` = queries of `t` + queries of the continuation. -/ +@[simp] theorem queriesOn_bind (oracle : Q → R) (t : QueryTree Q R α) (f : α → QueryTree Q R β) : + (t.bind f).queriesOn oracle = + t.queriesOn oracle + (f (t.eval oracle)).queriesOn oracle := by + induction t with + | pure a => simp [QueryTree.bind, queriesOn, eval] + | query q cont ih => simp only [QueryTree.bind, queriesOn_query, eval_query, ih (oracle q)]; omega + +@[simp] theorem queriesOn_ask (oracle : Q → R) (q : Q) : + (ask q : QueryTree Q R R).queriesOn oracle = 1 := rfl + +@[simp] theorem eval_ask (oracle : Q → R) (q : Q) : + (ask q : QueryTree Q R R).eval oracle = oracle q := rfl + +end QueryTree + +end Cslib.Query + +end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean new file mode 100644 index 000000000..64c6d3de3 --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison, Shreyas Srinivas +-/ +module + +public import Cslib.Algorithms.Lean.Query.Sort.LEQuery + +/-! # Insertion Sort as a Query Program + +Insertion sort implemented as a `Prog (LEQuery α)`, making all comparison queries explicit. +-/ + +open Cslib.Query + +public section + +namespace Cslib.Query + +/-- Insert `x` into a sorted list using comparison queries. -/ +@[expose] def orderedInsert (x : α) : List α → Prog (LEQuery α) (List α) + | [] => pure [x] + | y :: ys => do + let le ← LEQuery.ask x y + if le then + pure (x :: y :: ys) + else do + let rest ← orderedInsert x ys + pure (y :: rest) + +/-- Sort a list using insertion sort with comparison queries. -/ +@[expose] def insertionSort : List α → Prog (LEQuery α) (List α) + | [] => pure [] + | x :: xs => do + let sorted ← insertionSort xs + orderedInsert x sorted + +end Cslib.Query + +end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean new file mode 100644 index 000000000..b566a1d16 --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean @@ -0,0 +1,168 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison, Shreyas Srinivas +-/ +module + +public import Cslib.Algorithms.Lean.Query.Bounds +public import Cslib.Algorithms.Lean.Query.Sort.IsSort +public import Cslib.Algorithms.Lean.Query.Sort.Insertion.Defs +import Mathlib.Data.List.Sort +import Mathlib.Tactic.Ring +public import Mathlib.Algebra.Group.Defs + +/-! # Insertion Sort: Correctness and Upper Bound + +Proofs that `insertionSort` is a correct comparison sort and uses at most `n²` queries. +All proofs are by plain equational reasoning on `Prog.eval` and `Prog.queriesOn`. +-/ + +open Cslib.Query + +public section + +namespace Cslib.Query + +variable {α : Type} + +-- ## Evaluation simp lemmas for orderedInsert + +@[simp] theorem eval_orderedInsert_nil (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) : + (orderedInsert x ([] : List α)).eval oracle = [x] := by + simp [orderedInsert] + +@[simp] theorem eval_orderedInsert_cons (oracle : {ι : Type} → LEQuery α ι → ι) (x y : α) + (ys : List α) : + (orderedInsert x (y :: ys)).eval oracle = + if oracle (.le x y) then x :: y :: ys + else y :: (orderedInsert x ys).eval oracle := by + simp [orderedInsert, LEQuery.ask] + split <;> simp_all + +-- ## Evaluation simp lemmas for insertionSort + +@[simp] theorem eval_insertionSort_nil (oracle : {ι : Type} → LEQuery α ι → ι) : + (insertionSort (α := α) []).eval oracle = [] := by + simp [insertionSort] + +@[simp] theorem eval_insertionSort_cons (oracle : {ι : Type} → LEQuery α ι → ι) + (x : α) (xs : List α) : + (insertionSort (x :: xs)).eval oracle = + (orderedInsert x ((insertionSort xs).eval oracle)).eval oracle := by + simp [insertionSort] + +-- ## Permutation proofs + +theorem orderedInsert_perm (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) (xs : List α) : + ((orderedInsert x xs).eval oracle).Perm (x :: xs) := by + induction xs with + | nil => simp + | cons y ys ih => + simp only [eval_orderedInsert_cons] + split + · exact List.Perm.refl _ + · exact (List.Perm.cons _ ih).trans (List.Perm.swap _ _ _) + +theorem insertionSort_perm (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : + ((insertionSort xs).eval oracle).Perm xs := by + induction xs with + | nil => simp + | cons x xs ih => + simp only [eval_insertionSort_cons] + exact (orderedInsert_perm oracle x _).trans (List.Perm.cons _ ih) + +-- ## Sortedness proofs + +theorem orderedInsert_sorted + (r : α → α → Prop) [DecidableRel r] [Std.Total r] [IsTrans α r] + (oracle : {ι : Type} → LEQuery α ι → ι) + (horacle : ∀ a b, oracle (.le a b) = decide (r a b)) + (x : α) (xs : List α) (hxs : xs.Pairwise r) : + ((orderedInsert x xs).eval oracle).Pairwise r := by + induction xs with + | nil => simp + | cons y ys ih => + simp only [eval_orderedInsert_cons, horacle] + split + next h => + have hle : r x y := by simpa [decide_eq_true_eq] using h + exact List.pairwise_cons.mpr ⟨fun z hz => + match List.mem_cons.mp hz with + | .inl h => h ▸ hle + | .inr h => _root_.trans hle (List.rel_of_pairwise_cons hxs h), hxs⟩ + next h => + have hle : ¬ r x y := by simpa [decide_eq_true_eq] using h + have hyx : r y x := (Std.Total.total y x).resolve_right hle + have ih' := ih hxs.of_cons + have hperm := orderedInsert_perm oracle x ys + exact List.pairwise_cons.mpr ⟨fun z hz => + match List.mem_cons.mp (hperm.mem_iff.mp hz) with + | .inl h => h ▸ hyx + | .inr h => List.rel_of_pairwise_cons hxs h, ih'⟩ + +theorem insertionSort_sorted + (r : α → α → Prop) [DecidableRel r] [Std.Total r] [IsTrans α r] + (oracle : {ι : Type} → LEQuery α ι → ι) + (horacle : ∀ a b, oracle (.le a b) = decide (r a b)) + (xs : List α) : + ((insertionSort xs).eval oracle).Pairwise r := by + induction xs with + | nil => simp + | cons x xs ih => + simp only [eval_insertionSort_cons] + exact orderedInsert_sorted r oracle horacle x _ ih + +-- ## Query count proofs + +theorem orderedInsert_queriesOn_le (oracle : {ι : Type} → LEQuery α ι → ι) + (x : α) (xs : List α) : + (orderedInsert x xs).queriesOn oracle ≤ xs.length := by + induction xs with + | nil => simp [orderedInsert] + | cons y ys ih => + unfold orderedInsert LEQuery.ask + simp + split + · simp_all + · simp_all; omega + +theorem insertionSort_queriesOn_le (oracle : {ι : Type} → LEQuery α ι → ι) + (xs : List α) : + (insertionSort xs).queriesOn oracle ≤ xs.length ^ 2 := by + induction xs with + | nil => simp [insertionSort] + | cons x xs ih => + have hq : (insertionSort (x :: xs)).queriesOn oracle = + (insertionSort xs).queriesOn oracle + + (orderedInsert x ((insertionSort xs).eval oracle)).queriesOn oracle := by + simp [insertionSort] + rw [hq] + have hlen : ((insertionSort xs).eval oracle).length = xs.length := + (insertionSort_perm oracle xs).length_eq + have hord := orderedInsert_queriesOn_le oracle x ((insertionSort xs).eval oracle) + rw [hlen] at hord + have h1 := Nat.add_le_add ih hord + have hpow : xs.length ^ 2 + xs.length ≤ (xs.length + 1) ^ 2 := by + have : (xs.length + 1) ^ 2 = xs.length ^ 2 + 2 * xs.length + 1 := by ring + omega + simp only [List.length_cons] + exact Nat.le_trans h1 hpow + +-- ## UpperBound and IsSort instances + +public theorem insertionSort_upperBound : + UpperBound (insertionSort (α := α)) List.length (· ^ 2) := by + intro oracle n x hle + exact Nat.le_trans (insertionSort_queriesOn_le oracle x) + (Nat.pow_le_pow_left hle 2) + +public theorem insertionSort_isSort : IsSort (insertionSort (α := α)) where + perm xs oracle := insertionSort_perm oracle xs + sorted := by + intro xs oracle r _ _ _ horacle + exact insertionSort_sorted r oracle horacle xs + +end Cslib.Query + +end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean b/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean new file mode 100644 index 000000000..72f435ab1 --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison, Shreyas Srinivas +-/ +module + +public import Cslib.Algorithms.Lean.Query.Sort.LEQuery + +/-! # IsSort: Specification for Comparison Sorts + +`IsSort sort` asserts that `sort` is a correct comparison sort when viewed as a `Prog` +over `LEQuery α`. Correctness means: for any oracle, the result is a permutation of the +input; and for any oracle implementing a total order, the result is sorted. +-/ + +open Cslib.Query + +public section + +namespace Cslib.Query + +/-- A `Prog`-based function is a correct comparison sort if it always produces a permutation + of its input, and produces a sorted list when the oracle implements a total order. -/ +structure IsSort (sort : List α → Prog (LEQuery α) (List α)) : Prop where + /-- The sort produces a permutation of its input, for any oracle. -/ + perm : ∀ (xs : List α) (oracle : {ι : Type} → LEQuery α ι → ι), + ((sort xs).eval oracle).Perm xs + /-- The sort produces a sorted list, when the oracle implements a total order. -/ + sorted : ∀ (xs : List α) (oracle : {ι : Type} → LEQuery α ι → ι) + (r : α → α → Prop) [DecidableRel r] [Std.Total r] [IsTrans α r] + (_ : ∀ a b, oracle (.le a b) = decide (r a b)), + ((sort xs).eval oracle).Pairwise r + +end Cslib.Query + +end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean b/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean new file mode 100644 index 000000000..35673f0ec --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sebastian Graf, Kim Morrison, Shreyas Srinivas +-/ +module + +public import Cslib.Algorithms.Lean.Query.Prog + +/-! # LEQuery: Comparison Queries for Sorting + +`LEQuery α` is the query type for comparison-based sorting algorithms. +A query `LEQuery.le a b` asks whether `a ≤ b` and returns a `Bool`. +-/ + +open Cslib.Query + +public section + +namespace Cslib.Query + +/-- Comparison query: asks whether `a ≤ b`, returning a `Bool`. -/ +inductive LEQuery (α : Type) : Type → Type where + | le (a b : α) : LEQuery α Bool + +/-- Lift `LEQuery.le a b` into a `Prog` that returns the comparison result. -/ +@[expose] def LEQuery.ask (a b : α) : Prog (LEQuery α) Bool := + .liftBind (.le a b) .pure + +@[simp] theorem LEQuery.eval_ask (oracle : {ι : Type} → LEQuery α ι → ι) (a b : α) : + Prog.eval oracle (LEQuery.ask a b) = oracle (.le a b) := rfl + +end Cslib.Query + +end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean new file mode 100644 index 000000000..717a68e46 --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean @@ -0,0 +1,214 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison, Shreyas Srinivas, Eric Wieser +-/ +module + +public import Cslib.Algorithms.Lean.Query.Bounds +public import Cslib.Algorithms.Lean.Query.Sort.IsSort +public import Cslib.Algorithms.Lean.Query.Sort.QueryTree +public import Mathlib.Data.List.Sort +public import Mathlib.Data.Nat.Factorial.Basic +public import Mathlib.Data.Fintype.Perm +public import Mathlib.Data.List.FinRange +public import Mathlib.SetTheory.Cardinal.Order + +/-! # Comparison Sorting Lower Bound + +`IsSort.lowerBound_infinite`: any correct comparison sort on an infinite type +has query complexity at least `⌈log₂(n!)⌉` for every input size `n`. + +The proof constructs `n!` distinct total orders on `α` (one per permutation of `n` +embedded elements), shows they produce distinct sorted outputs, and applies +`QueryTree.exists_queriesOn_ge_clog`. + +## Prog-to-QueryTree Bridge + +Since `Prog (LEQuery α) β` uses an existentially quantified response type per query (via +`FreeM.liftBind`), while `QueryTree` has a fixed response type `R`, we provide a conversion +`Prog.toQueryTree` that exploits the fact that `LEQuery α` only has one constructor returning +`Bool`. This lets us apply the combinatorial depth lemma on `QueryTree` and transfer results +back to `Prog`. +-/ + +open Cslib.Query + +public section + +namespace Cslib.Query + +-- ## Prog-to-QueryTree bridge for LEQuery + +/-- Convert a `Prog`-oracle to a `QueryTree`-oracle for `LEQuery`. -/ +@[expose] def toQTOracle (oracle : {ι : Type} → LEQuery α ι → ι) : (α × α) → Bool := + fun (a, b) => oracle (.le a b) + +/-- Convert a `QueryTree`-oracle to a `Prog`-oracle for `LEQuery`. -/ +@[expose] def fromQTOracle (f : (α × α) → Bool) : {ι : Type} → LEQuery α ι → ι + | _, .le a b => f (a, b) + +@[simp] theorem fromQTOracle_le (f : (α × α) → Bool) (a b : α) : + fromQTOracle f (.le a b) = f (a, b) := rfl + +@[simp] theorem toQTOracle_fromQTOracle (f : (α × α) → Bool) : + toQTOracle (fromQTOracle f) = f := rfl + +/-- Convert a `Prog (LEQuery α)` program to a `QueryTree (α × α) Bool` decision tree. -/ +@[expose] def Prog.toQueryTree : Prog (LEQuery α) β → QueryTree (α × α) Bool β + | .pure a => .pure a + | .liftBind (.le a b) cont => .query (a, b) (fun r => Prog.toQueryTree (cont r)) + +/-- Evaluation is preserved by the Prog-to-QueryTree conversion. -/ +@[simp] theorem Prog.toQueryTree_eval (oracle : {ι : Type} → LEQuery α ι → ι) : + (p : Prog (LEQuery α) β) → + p.toQueryTree.eval (toQTOracle oracle) = p.eval oracle + | .pure _ => rfl + | .liftBind (.le a b) cont => by + simp only [toQueryTree, QueryTree.eval_query, Prog.eval, toQTOracle] + exact toQueryTree_eval oracle (cont (oracle (.le a b))) + +/-- Query count is preserved by the Prog-to-QueryTree conversion. -/ +@[simp] theorem Prog.toQueryTree_queriesOn (oracle : {ι : Type} → LEQuery α ι → ι) : + (p : Prog (LEQuery α) β) → + p.toQueryTree.queriesOn (toQTOracle oracle) = p.queriesOn oracle + | .pure _ => rfl + | .liftBind (.le a b) cont => by + simp only [toQueryTree, QueryTree.queriesOn_query, Prog.queriesOn, toQTOracle] + exact congrArg (1 + ·) (toQueryTree_queriesOn oracle (cont (oracle (.le a b)))) + +-- ## infinitePermOrder: constructing n! distinct total orders + +open Classical in +/-- A total order on an infinite type `α` that orders `n` embedded elements + (via `Infinite.natEmbedding`) according to `σ⁻¹`, with embedded elements + preceding all others, and a well-ordering among non-embedded elements. -/ +private noncomputable def infinitePermOrder [Infinite α] (n : Nat) + (σ : Equiv.Perm (Fin n)) (a b : α) : Prop := + if ha : ∃ i : Fin n, (Infinite.natEmbedding α) i.val = a then + if hb : ∃ j : Fin n, (Infinite.natEmbedding α) j.val = b then + σ.symm ha.choose ≤ σ.symm hb.choose + else True + else + if _ : ∃ j : Fin n, (Infinite.natEmbedding α) j.val = b then False + else @LE.le α (IsWellOrder.linearOrder (α := α) WellOrderingRel).toLE a b + +private noncomputable instance [Infinite α] : + DecidableRel (infinitePermOrder (α := α) n σ) := Classical.decRel _ + +private theorem infinitePermOrder.choose_eq [Infinite α] {i : Fin n} + (h : ∃ j : Fin n, (Infinite.natEmbedding α) j.val = (Infinite.natEmbedding α) i.val) : + h.choose = i := by + grind + +private instance [Infinite α] : + IsTrans α (infinitePermOrder (α := α) n σ) where + trans a b c hab hbc := by + letI : LinearOrder α := IsWellOrder.linearOrder WellOrderingRel + unfold infinitePermOrder at * + by_cases ha : ∃ i : Fin n, (Infinite.natEmbedding α) i.val = a <;> + by_cases hb : ∃ j : Fin n, (Infinite.natEmbedding α) j.val = b <;> + by_cases hc : ∃ k : Fin n, (Infinite.natEmbedding α) k.val = c <;> + grind + +private instance [Infinite α] : + Std.Total (infinitePermOrder (α := α) n σ) where + total a b := by + letI : LinearOrder α := IsWellOrder.linearOrder WellOrderingRel + unfold infinitePermOrder + by_cases ha : ∃ i : Fin n, (Infinite.natEmbedding α) i.val = a + · simp only [dite_else_true] + grind + · simp_all only [reduceDIte, dite_eq_ite, if_true_left] + grind + +attribute [local grind inj] Equiv.injective in +private instance [Infinite α] : + Std.Antisymm (infinitePermOrder (α := α) n σ) where + antisymm a b hab hba := by + letI : LinearOrder α := IsWellOrder.linearOrder WellOrderingRel + simp only [infinitePermOrder] at hab hba + by_cases ha : ∃ i : Fin n, (Infinite.natEmbedding α) i.val = a <;> + by_cases hb : ∃ j : Fin n, (Infinite.natEmbedding α) j.val = b <;> + simp_all only [↓reduceDIte, not_exists] <;> grind + +/-- `infinitePermOrder` restricted to embedded values matches `σ⁻¹(·) ≤ σ⁻¹(·)`. -/ +@[grind =] +private theorem infinitePermOrder_on_embedded [Infinite α] {i j : Fin n} : + infinitePermOrder (α := α) n σ ((Infinite.natEmbedding α) i.val) + ((Infinite.natEmbedding α) j.val) ↔ σ.symm i ≤ σ.symm j := by + have hi : ∃ k : Fin n, (Infinite.natEmbedding α) k.val = (Infinite.natEmbedding α) i.val := + ⟨i, rfl⟩ + have hj : ∃ k : Fin n, (Infinite.natEmbedding α) k.val = (Infinite.natEmbedding α) j.val := + ⟨j, rfl⟩ + grind [infinitePermOrder] + +/-- `map (ι ∘ Fin.val ∘ σ) (finRange n)` is pairwise sorted by `infinitePermOrder n σ`. -/ +private theorem pairwise_map_infinitePermOrder [Infinite α] (σ : Equiv.Perm (Fin n)) : + List.Pairwise (infinitePermOrder (α := α) n σ) + ((List.finRange n).map (fun i => (Infinite.natEmbedding α) (σ i).val)) := by + rw [List.pairwise_map] + exact (List.pairwise_le_finRange n).imp fun hab => by grind + +/-- `map (ι ∘ Fin.val ∘ σ) (finRange n)` is a permutation of `map (ι ∘ Fin.val) (finRange n)`. -/ +private theorem map_perm_of_infinite_embedding [Infinite α] (σ : Equiv.Perm (Fin n)) : + ((List.finRange n).map (fun i => (Infinite.natEmbedding α) (σ i).val)).Perm + ((List.finRange n).map (fun i => (Infinite.natEmbedding α) i.val)) := by + rw [show (fun i => (Infinite.natEmbedding α) (σ i).val) = + (fun i => (Infinite.natEmbedding α) i.val) ∘ σ from rfl] + grind [Equiv.Perm.map_finRange_perm] + +/-- Different permutations give different `map (ι ∘ Fin.val ∘ σ) (finRange n)`. -/ +private theorem map_infinite_embedding_injective [Infinite α] : + Function.Injective (fun σ : Equiv.Perm (Fin n) => + (List.finRange n).map (fun i => (Infinite.natEmbedding α) (σ i).val)) := by + intro σ τ h + exact Equiv.ext fun i => by + have := List.map_inj_left.mp h i (List.mem_finRange i) + grind + +-- ## Main theorem + +/-- Any correct comparison sort on an infinite type has query complexity at least `⌈log₂(n!)⌉` + for every input size `n`. -/ +theorem IsSort.lowerBound_infinite [Infinite α] + {sort : List α → Prog (LEQuery α) (List α)} + (h : IsSort sort) : + LowerBound sort List.length (fun n => Nat.clog 2 (Nat.factorial n)) := by + intro n + set ι := Infinite.natEmbedding α + refine ⟨(List.finRange n).map (fun i => ι i.val), by simp, ?_⟩ + set xs := (List.finRange n).map (fun i => ι i.val) + set tree := (sort xs).toQueryTree + have hcard : Fintype.card (Equiv.Perm (Fin n)) = Nat.factorial n := by + rw [Fintype.card_perm, Fintype.card_fin] + let e := Fintype.equivFinOfCardEq hcard + -- Define Prog-level oracles, then derive QueryTree oracles from them + let progOracles : Fin (Nat.factorial n) → ({ι : Type} → LEQuery α ι → ι) := + fun i => fromQTOracle (fun p => decide (infinitePermOrder n (e.symm i) p.1 p.2)) + let qtOracles : Fin (Nat.factorial n) → ((α × α) → Bool) := + fun i => toQTOracle (progOracles i) + -- Each oracle produces a unique sorted output + have h_inj : Function.Injective (fun i => tree.eval (qtOracles i)) := by + intro i j h_eval + suffices key : ∀ i, (sort xs).eval (progOracles i) = + (List.finRange n).map (fun k => ι ((e.symm i) k).val) by + simp only [tree, qtOracles, Prog.toQueryTree_eval] at h_eval + rw [key, key] at h_eval + exact e.symm.injective (map_infinite_embedding_injective h_eval) + intro i + have h_perm := h.perm xs (progOracles i) + have h_sorted := h.sorted xs (progOracles i) + (infinitePermOrder (α := α) n (e.symm i)) + (fun a b => by simp [progOracles]) + exact h_perm.trans (map_perm_of_infinite_embedding (e.symm i)).symm |>.eq_of_pairwise' + h_sorted (pairwise_map_infinitePermOrder (e.symm i)) + -- Apply the depth lemma + obtain ⟨i, hi⟩ := QueryTree.exists_queriesOn_ge_clog tree qtOracles (Nat.factorial_pos n) h_inj + refine ⟨progOracles i, ?_⟩ + simp only [tree, qtOracles, Prog.toQueryTree_queriesOn] at hi + exact hi + +end Cslib.Query + +end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean new file mode 100644 index 000000000..2f4ce9b4f --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison, Shreyas Srinivas, Sorrachai Yingchareonthawornchai +-/ +module + +public import Cslib.Algorithms.Lean.Query.Sort.LEQuery + +/-! # Merge Sort as a Query Program + +Merge sort implemented as a `Prog (LEQuery α)`, making all comparison queries explicit. +Uses an alternating split (odds/evens) to avoid needing `List.length` in the termination +argument. +-/ + +open Cslib.Query + +public section + +namespace Cslib.Query + +/-- Split a list into two halves by alternating elements. -/ +@[expose] def split : List α → List α × List α + | [] => ([], []) + | [x] => ([x], []) + | x :: y :: zs => + let (l, r) := split zs + (x :: l, y :: r) + +@[simp] theorem split_nil : split (α := α) [] = ([], []) := rfl +@[simp] theorem split_singleton (x : α) : split [x] = ([x], []) := rfl +@[simp] theorem split_cons_cons (x y : α) (zs : List α) : + split (x :: y :: zs) = ((split zs).1 |>.cons x, (split zs).2 |>.cons y) := by + simp [split] + +theorem split_fst_length_eq : ∀ (xs : List α), + (split xs).1.length = (xs.length + 1) / 2 + | [] => by simp [split] + | [_] => by simp [split] + | _ :: _ :: zs => by + simp only [split_cons_cons, List.length_cons] + have := split_fst_length_eq zs + omega + +theorem split_snd_length_eq : ∀ (xs : List α), + (split xs).2.length = xs.length / 2 + | [] => by simp [split] + | [_] => by simp [split] + | _ :: _ :: zs => by + simp only [split_cons_cons, List.length_cons] + have := split_snd_length_eq zs + omega + +theorem split_fst_length_lt (x y : α) (zs : List α) : + (split (x :: y :: zs)).1.length < (x :: y :: zs).length := by + simp only [split_fst_length_eq, List.length_cons]; omega + +theorem split_snd_length_lt (x y : α) (zs : List α) : + (split (x :: y :: zs)).2.length < (x :: y :: zs).length := by + simp only [split_snd_length_eq, List.length_cons]; omega + +/-- Merge two sorted lists using comparison queries. -/ +@[expose] def merge (xs ys : List α) : Prog (LEQuery α) (List α) := + match xs, ys with + | [], ys => pure ys + | xs, [] => pure xs + | x :: xs', y :: ys' => do + let le ← LEQuery.ask x y + if le then do + let rest ← merge xs' (y :: ys') + pure (x :: rest) + else do + let rest ← merge (x :: xs') ys' + pure (y :: rest) +termination_by xs.length + ys.length + +/-- Sort a list using merge sort with comparison queries. -/ +@[expose] def mergeSort (xs : List α) : Prog (LEQuery α) (List α) := + match xs with + | [] => pure [] + | [x] => pure [x] + | x :: y :: zs => do + let sl ← mergeSort (split (x :: y :: zs)).1 + let sr ← mergeSort (split (x :: y :: zs)).2 + merge sl sr +termination_by xs.length +decreasing_by + · exact split_fst_length_lt x y zs + · exact split_snd_length_lt x y zs + +end Cslib.Query + +end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean new file mode 100644 index 000000000..bca7d4dce --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean @@ -0,0 +1,271 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison, Shreyas Srinivas, Sorrachai Yingchareonthawornchai +-/ +module + +public import Cslib.Algorithms.Lean.Query.Bounds +public import Cslib.Algorithms.Lean.Query.Sort.IsSort +public import Cslib.Algorithms.Lean.Query.Sort.Merge.Defs +import Mathlib.Data.List.Sort +public import Mathlib.Algebra.Group.Defs +public import Mathlib.Data.Nat.Log + +/-! # Merge Sort: Correctness and Upper Bound + +Proofs that `mergeSort` is a correct comparison sort and uses at most `n * ⌈log₂ n⌉` queries. +All proofs are by plain equational reasoning on `Prog.eval` and `Prog.queriesOn`. +-/ + +open Cslib.Query + +public section + +namespace Cslib.Query + +variable {α : Type} + +-- ## Split lemmas + +theorem split_perm : ∀ (xs : List α), + ((split xs).1 ++ (split xs).2).Perm xs + | [] => List.Perm.refl _ + | [_] => List.Perm.refl _ + | x :: y :: zs => by + simp only [split_cons_cons] + show ((x :: (split zs).1) ++ (y :: (split zs).2)).Perm (x :: y :: zs) + rw [List.cons_append] + refine List.Perm.cons _ ?_ + -- goal: ((split zs).1 ++ y :: (split zs).2).Perm (y :: zs) + exact (List.perm_middle).trans (List.Perm.cons _ (split_perm zs)) + +theorem split_lengths_add (xs : List α) : + (split xs).1.length + (split xs).2.length = xs.length := by + simp [split_fst_length_eq, split_snd_length_eq]; omega + +-- ## Evaluation simp lemmas for merge + +@[simp] theorem eval_merge_nil_left (oracle : {ι : Type} → LEQuery α ι → ι) (ys : List α) : + (merge ([] : List α) ys).eval oracle = ys := by + simp [merge] + +@[simp] theorem eval_merge_nil_right (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : + (merge xs ([] : List α)).eval oracle = xs := by + cases xs <;> simp [merge] + +@[simp] theorem eval_merge_cons_cons (oracle : {ι : Type} → LEQuery α ι → ι) + (x : α) (xs' : List α) (y : α) (ys' : List α) : + (merge (x :: xs') (y :: ys')).eval oracle = + if oracle (.le x y) + then x :: (merge xs' (y :: ys')).eval oracle + else y :: (merge (x :: xs') ys').eval oracle := by + simp [merge, LEQuery.ask] + split <;> simp_all + +-- ## Evaluation simp lemmas for mergeSort + +@[simp] theorem eval_mergeSort_nil (oracle : {ι : Type} → LEQuery α ι → ι) : + (mergeSort (α := α) []).eval oracle = [] := by + simp [mergeSort] + +@[simp] theorem eval_mergeSort_singleton (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) : + (mergeSort [x]).eval oracle = [x] := by + simp [mergeSort] + +@[simp] theorem eval_mergeSort_cons_cons (oracle : {ι : Type} → LEQuery α ι → ι) + (x y : α) (zs : List α) : + (mergeSort (x :: y :: zs)).eval oracle = + (merge + ((mergeSort (split (x :: y :: zs)).1).eval oracle) + ((mergeSort (split (x :: y :: zs)).2).eval oracle)).eval oracle := by + simp [mergeSort] + +-- ## Permutation proofs + +theorem merge_perm (oracle : {ι : Type} → LEQuery α ι → ι) (xs ys : List α) : + ((merge xs ys).eval oracle).Perm (xs ++ ys) := by + induction xs, ys using merge.induct (α := α) with + | case1 ys => simp + | case2 xs => simp + | case3 x xs' y ys' ih_true ih_false => + simp only [eval_merge_cons_cons] + split + · exact List.Perm.cons _ ih_true + · -- goal: (y :: (merge (x :: xs') ys').eval oracle).Perm (x :: xs' ++ y :: ys') + -- ih: ((merge (x :: xs') ys').eval oracle).Perm ((x :: xs') ++ ys') + exact (List.Perm.cons _ ih_false).trans List.perm_middle.symm + +theorem mergeSort_perm (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : + ((mergeSort xs).eval oracle).Perm xs := by + induction xs using mergeSort.induct (α := α) with + | case1 => simp + | case2 x => simp + | case3 x y zs ih_l ih_r => + simp only [eval_mergeSort_cons_cons] + exact (merge_perm oracle _ _).trans ((ih_l.append ih_r).trans (split_perm _)) + +-- ## Sortedness proofs + +/-- If `l` is a permutation of `xs ++ ys`, and `r a` holds for all elements of `xs` and `ys`, + then `r a` holds for all elements of `l`. -/ +private theorem forall_mem_of_perm_append {r : α → Prop} {l xs ys : List α} + (hperm : l.Perm (xs ++ ys)) + (hxs : ∀ z ∈ xs, r z) (hys : ∀ z ∈ ys, r z) : + ∀ z ∈ l, r z := by + intro z hz + rcases List.mem_append.mp (hperm.mem_iff.mp hz) with h | h + · exact hxs z h + · exact hys z h + +theorem merge_sorted + (r : α → α → Prop) [DecidableRel r] [Std.Total r] [IsTrans α r] + (oracle : {ι : Type} → LEQuery α ι → ι) + (horacle : ∀ a b, oracle (.le a b) = decide (r a b)) + (xs ys : List α) (hxs : xs.Pairwise r) (hys : ys.Pairwise r) : + ((merge xs ys).eval oracle).Pairwise r := by + induction xs, ys using merge.induct (α := α) with + | case1 ys => simpa + | case2 xs => simpa + | case3 x xs' y ys' ih_true ih_false => + simp only [eval_merge_cons_cons, horacle] + have hxs' := hxs.of_cons + have hys' := hys.of_cons + split + next h => + have hle : r x y := by simpa [decide_eq_true_eq] using h + refine List.pairwise_cons.mpr ⟨?_, ih_true hxs' hys⟩ + exact forall_mem_of_perm_append (merge_perm oracle xs' (y :: ys')) + (fun _ hz => List.rel_of_pairwise_cons hxs hz) + (fun z hz => by + rcases List.mem_cons.mp hz with rfl | h + · exact hle + · exact _root_.trans hle (List.rel_of_pairwise_cons hys h)) + next h => + have hle : ¬ r x y := by simpa [decide_eq_true_eq] using h + have hyx : r y x := (Std.Total.total y x).resolve_right hle + refine List.pairwise_cons.mpr ⟨?_, ih_false hxs hys'⟩ + exact forall_mem_of_perm_append (merge_perm oracle (x :: xs') ys') + (fun z hz => by + rcases List.mem_cons.mp hz with rfl | h + · exact hyx + · exact _root_.trans hyx (List.rel_of_pairwise_cons hxs h)) + (fun _ hz => List.rel_of_pairwise_cons hys hz) + +theorem mergeSort_sorted + (r : α → α → Prop) [DecidableRel r] [Std.Total r] [IsTrans α r] + (oracle : {ι : Type} → LEQuery α ι → ι) + (horacle : ∀ a b, oracle (.le a b) = decide (r a b)) + (xs : List α) : + ((mergeSort xs).eval oracle).Pairwise r := by + induction xs using mergeSort.induct (α := α) with + | case1 => simp + | case2 x => simp + | case3 x y zs ih_l ih_r => + simp only [eval_mergeSort_cons_cons] + exact merge_sorted r oracle horacle _ _ ih_l ih_r + +-- ## Query count simp lemmas + +@[simp] theorem queriesOn_merge_nil_left (oracle : {ι : Type} → LEQuery α ι → ι) (ys : List α) : + (merge ([] : List α) ys).queriesOn oracle = 0 := by + simp [merge] + +@[simp] theorem queriesOn_merge_nil_right (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : + (merge xs ([] : List α)).queriesOn oracle = 0 := by + cases xs <;> simp [merge] + +@[simp] theorem queriesOn_merge_cons_cons (oracle : {ι : Type} → LEQuery α ι → ι) + (x : α) (xs' : List α) (y : α) (ys' : List α) : + (merge (x :: xs') (y :: ys')).queriesOn oracle = + 1 + if oracle (.le x y) + then (merge xs' (y :: ys')).queriesOn oracle + else (merge (x :: xs') ys').queriesOn oracle := by + simp [merge, LEQuery.ask] + split <;> simp_all + +@[simp] theorem queriesOn_mergeSort_nil (oracle : {ι : Type} → LEQuery α ι → ι) : + (mergeSort (α := α) []).queriesOn oracle = 0 := by + simp [mergeSort] + +@[simp] theorem queriesOn_mergeSort_singleton (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) : + (mergeSort [x]).queriesOn oracle = 0 := by + simp [mergeSort] + +@[simp] theorem queriesOn_mergeSort_cons_cons (oracle : {ι : Type} → LEQuery α ι → ι) + (x y : α) (zs : List α) : + (mergeSort (x :: y :: zs)).queriesOn oracle = + (mergeSort (split (x :: y :: zs)).1).queriesOn oracle + + ((mergeSort (split (x :: y :: zs)).2).queriesOn oracle + + (merge ((mergeSort (split (x :: y :: zs)).1).eval oracle) + ((mergeSort (split (x :: y :: zs)).2).eval oracle)).queriesOn oracle) := by + simp [mergeSort] + +-- ## Query count proofs + +theorem merge_queriesOn_le (oracle : {ι : Type} → LEQuery α ι → ι) + (xs ys : List α) : + (merge xs ys).queriesOn oracle ≤ xs.length + ys.length := by + induction xs, ys using merge.induct (α := α) with + | case1 ys => simp + | case2 xs => simp + | case3 x xs' y ys' ih_true ih_false => + simp only [queriesOn_merge_cons_cons, List.length_cons] + split <;> simp_all <;> omega + +/-- The key arithmetic inequality for the merge sort recurrence: + `⌈n/2⌉ * clog(⌈n/2⌉) + ⌊n/2⌋ * clog(⌊n/2⌋) + n ≤ n * clog(n)`. -/ +private theorem mergeSort_bound (n : ℕ) (hn : 2 ≤ n) : + ((n + 1) / 2) * Nat.clog 2 ((n + 1) / 2) + + (n / 2 * Nat.clog 2 (n / 2) + ((n + 1) / 2 + n / 2)) ≤ + n * Nat.clog 2 n := by + have hclog := Nat.clog_of_one_lt (by omega : (1 : Nat) < 2) hn + have hceil : Nat.clog 2 ((n + 1) / 2) + 1 ≤ Nat.clog 2 n := le_of_eq hclog.symm + have hfloor : Nat.clog 2 (n / 2) + 1 ≤ Nat.clog 2 n := + (Nat.add_le_add_right (Nat.clog_mono_right 2 (by omega)) 1).trans hceil + have hsum : (n + 1) / 2 + n / 2 = n := by omega + have h1 := Nat.mul_le_mul_left ((n + 1) / 2) hceil + have h2 := Nat.mul_le_mul_left (n / 2) hfloor + rw [Nat.mul_succ] at h1 h2 + calc _ = ((n + 1) / 2 * Nat.clog 2 ((n + 1) / 2) + (n + 1) / 2) + + (n / 2 * Nat.clog 2 (n / 2) + n / 2) := by omega + _ ≤ (n + 1) / 2 * Nat.clog 2 n + n / 2 * Nat.clog 2 n := Nat.add_le_add h1 h2 + _ = ((n + 1) / 2 + n / 2) * Nat.clog 2 n := (Nat.add_mul ..).symm + _ = n * Nat.clog 2 n := by rw [hsum] + +theorem mergeSort_queriesOn_le (oracle : {ι : Type} → LEQuery α ι → ι) + (xs : List α) : + (mergeSort xs).queriesOn oracle ≤ xs.length * Nat.clog 2 xs.length := by + induction xs using mergeSort.induct (α := α) with + | case1 => simp [mergeSort] + | case2 x => simp [mergeSort] + | case3 x y zs ih_l ih_r => + simp only [queriesOn_mergeSort_cons_cons] + have hml := merge_queriesOn_le oracle + ((mergeSort (split (x :: y :: zs)).1).eval oracle) + ((mergeSort (split (x :: y :: zs)).2).eval oracle) + rw [(mergeSort_perm oracle (split (x :: y :: zs)).1).length_eq, + (mergeSort_perm oracle (split (x :: y :: zs)).2).length_eq, + split_fst_length_eq, split_snd_length_eq] at hml + rw [split_fst_length_eq] at ih_l + rw [split_snd_length_eq] at ih_r + exact Nat.le_trans (Nat.add_le_add ih_l (Nat.add_le_add ih_r hml)) + (mergeSort_bound _ (by simp only [List.length_cons]; omega)) + +-- ## UpperBound and IsSort instances + +public theorem mergeSort_upperBound : + UpperBound (mergeSort (α := α)) List.length (fun n => n * Nat.clog 2 n) := by + intro oracle n x hle + exact Nat.le_trans (mergeSort_queriesOn_le oracle x) + (Nat.mul_le_mul hle (Nat.clog_mono_right 2 hle)) + +public theorem mergeSort_isSort : IsSort (mergeSort (α := α)) where + perm xs oracle := mergeSort_perm oracle xs + sorted := by + intro xs oracle r _ _ _ horacle + exact mergeSort_sorted r oracle horacle xs + +end Cslib.Query + +end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/QueryTree.lean b/Cslib/Algorithms/Lean/Query/Sort/QueryTree.lean new file mode 100644 index 000000000..fac1e43f4 --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/Sort/QueryTree.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sebastian Graf, Kim Morrison, Shreyas Srinivas +-/ +module + +public import Cslib.Algorithms.Lean.Query.QueryTree +public import Mathlib.Data.Set.Function +public import Mathlib.Combinatorics.Pigeonhole + +/-! # Lower-Bound Lemma for Query Trees + +`QueryTree.exists_queriesOn_ge_clog`: if `n` oracles produce `n` distinct evaluation results +from a query tree with `Fintype` responses, then one of those oracles makes at least +`⌈log_{|R|} n⌉` queries. + +The proof uses the adversarial/partition argument: at each query node, the `n` oracles split by +their answer into `|R|` groups; the largest group (size ≥ ⌈n/|R|⌉) still produces distinct results +in the corresponding subtree, and the induction proceeds there. + +The proof works over an arbitrary `Finset ι` of oracle indices (avoiding re-indexing via +`Fintype.equivFin`), then derives the `Fin n` version as a corollary. +-/ + +open Cslib.Query + +public section + +namespace Cslib.Query.QueryTree + +/-- Finset-based version: if the oracles indexed by `S` produce `|S|`-many distinct evaluation + results, then some oracle in `S` makes at least `⌈log_{|R|} |S|⌉` queries. -/ +private theorem exists_mem_queriesOn_ge_clog [Fintype R] + {ι : Type} (t : QueryTree Q R α) (S : Finset ι) (hS : S.Nonempty) + (oracles : ι → (Q → R)) + (h_inj : Set.InjOn (fun i => t.eval (oracles i)) ↑S) : + ∃ i ∈ S, t.queriesOn (oracles i) ≥ Nat.clog (Fintype.card R) S.card := by + classical + induction t generalizing ι S with + | pure a => + obtain ⟨i, hi⟩ := hS + exact ⟨i, hi, by simp [queriesOn, Nat.clog_of_right_le_one + (Finset.card_le_one.mpr fun _ ha _ hb => h_inj ha hb rfl)]⟩ + | query q cont ih => + by_cases hle : S.card ≤ 1 + · obtain ⟨i, hi⟩ := hS; exact ⟨i, hi, by simp [Nat.clog_of_right_le_one hle]⟩ + · push Not at hle + by_cases hR : Fintype.card R ≤ 1 + · obtain ⟨i, hi⟩ := hS; exact ⟨i, hi, by simp [Nat.clog_of_left_le_one hR]⟩ + · push Not at hR + -- Find b : R such that S.filter (oracles · q = b) has ≥ ⌈|S|/|R|⌉ elements + have ⟨b, _, hb⟩ : ∃ b ∈ Finset.univ (α := R), + (S.card - 1) / Fintype.card R < (S.filter (fun i => oracles i q = b)).card := by + apply Finset.exists_lt_card_fiber_of_mul_lt_card_of_maps_to + (fun a _ => Finset.mem_univ (oracles a q)) + simp only [Finset.card_univ] + calc Fintype.card R * ((S.card - 1) / Fintype.card R) + = (S.card - 1) / Fintype.card R * Fintype.card R := Nat.mul_comm .. + _ ≤ S.card - 1 := Nat.div_mul_le_self _ _ + _ < S.card := by omega + set S' := S.filter (fun i => oracles i q = b) + have hS' : S'.Nonempty := + Finset.card_pos.mp (Nat.lt_of_le_of_lt (Nat.zero_le _) hb) + -- Restricted injectivity: eval through query q cont agrees with cont b on S' + have h_inj' : Set.InjOn (fun i => (cont b).eval (oracles i)) ↑S' := by + intro i hi j hj heq + have him := Finset.mem_coe.mp hi |> Finset.mem_filter.mp + have hjm := Finset.mem_coe.mp hj |> Finset.mem_filter.mp + exact h_inj (Finset.mem_coe.mpr him.1) (Finset.mem_coe.mpr hjm.1) + (by simp [eval, him.2, hjm.2, heq]) + obtain ⟨i, hi, hiq⟩ := ih b S' hS' oracles h_inj' + have him := Finset.mem_filter.mp hi + refine ⟨i, him.1, ?_⟩ + simp only [queriesOn_query, him.2] + calc Nat.clog (Fintype.card R) S.card + ≤ 1 + Nat.clog (Fintype.card R) S'.card := by + rw [Nat.clog_of_two_le (by omega) (by omega)] + have h_ceil : (S.card + Fintype.card R - 1) / Fintype.card R = + (S.card - 1) / Fintype.card R + 1 := by + rw [show S.card + Fintype.card R - 1 = S.card - 1 + Fintype.card R from by omega] + exact Nat.add_div_right (S.card - 1) (by omega) + have := Nat.clog_mono_right (Fintype.card R) + (show (S.card + Fintype.card R - 1) / Fintype.card R ≤ S'.card by omega) + omega + _ ≤ 1 + (cont b).queriesOn (oracles i) := by omega + +/-- If `n` oracles produce `n` distinct evaluation results from a query tree with `Fintype` + responses, then one of those oracles makes at least `⌈log_{|R|} n⌉` queries. + + This is the core combinatorial lemma for query complexity lower bounds. + The proof uses the adversarial/partition argument: at each query node, the `n` oracles + split by their answer to the query; the largest group (size ≥ ⌈n/|R|⌉) still produces + distinct results in the corresponding subtree, and the induction proceeds there. -/ +theorem exists_queriesOn_ge_clog [Fintype R] + (t : QueryTree Q R α) (oracles : Fin n → (Q → R)) + (hn : 0 < n) + (h_inj : Function.Injective (fun i => t.eval (oracles i))) : + ∃ i : Fin n, t.queriesOn (oracles i) ≥ Nat.clog (Fintype.card R) n := by + have ⟨i, _, hi⟩ := exists_mem_queriesOn_ge_clog t Finset.univ + (Finset.univ_nonempty_iff.mpr ⟨⟨0, hn⟩⟩) oracles (h_inj.injOn) + rw [Finset.card_univ, Fintype.card_fin] at hi + exact ⟨i, hi⟩ + +end Cslib.Query.QueryTree + +end -- public section From 883edfd873114bc4e70fb57d8e77ee4e3f7c71ad Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Thu, 5 Mar 2026 09:01:36 +0000 Subject: [PATCH 44/75] feat(Query): add Prog.cost and complex multiplication example Add `Prog.cost`, a weighted generalization of `Prog.queriesOn` where each query type can have a different cost. Demonstrate this with complex multiplication: naive (4 muls + 2 adds) vs Gauss's trick (3 muls + 5 adds), proving correctness, exact parametric costs, and the crossover condition. Co-Authored-By: Claude Opus 4.6 Co-authored-by: Shrys --- Cslib.lean | 2 + Cslib/Algorithms/Lean/Query/Arith/Defs.lean | 83 +++++++++++++++++++ Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean | 68 +++++++++++++++ Cslib/Algorithms/Lean/Query/Prog.lean | 33 ++++++++ 4 files changed, 186 insertions(+) create mode 100644 Cslib/Algorithms/Lean/Query/Arith/Defs.lean create mode 100644 Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean diff --git a/Cslib.lean b/Cslib.lean index ebc248025..79175169d 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,6 +1,8 @@ module -- shake: keep-all public import Cslib.Algorithms.Lean.MergeSort.MergeSort +public import Cslib.Algorithms.Lean.Query.Arith.Defs +public import Cslib.Algorithms.Lean.Query.Arith.Lemmas public import Cslib.Algorithms.Lean.Query.Bounds public import Cslib.Algorithms.Lean.Query.Prog public import Cslib.Algorithms.Lean.Query.QueryTree diff --git a/Cslib/Algorithms/Lean/Query/Arith/Defs.lean b/Cslib/Algorithms/Lean/Query/Arith/Defs.lean new file mode 100644 index 000000000..f32257c08 --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/Arith/Defs.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison +-/ +module + +public import Cslib.Algorithms.Lean.Query.Prog + +/-! # Arithmetic Queries and Complex Multiplication + +Demonstrates the `Prog.cost` framework with non-uniform query costs. +`ArithQuery α` supports addition, subtraction, and multiplication, each with +independently parametrized costs. + +The motivating example is complex number multiplication, where two algorithms +(naive and Gauss's trick) trade multiplications for additions. With parametric +costs `c_add` and `c_mul`, the optimal choice depends on their ratio. +-/ + +open Cslib.Query + +public section + +namespace Cslib.Query + +/-- Arithmetic queries: addition, subtraction, and multiplication. -/ +inductive ArithQuery (α : Type) : Type → Type where + | add (a b : α) : ArithQuery α α + | sub (a b : α) : ArithQuery α α + | mul (a b : α) : ArithQuery α α + +namespace ArithQuery + +/-- Lift `ArithQuery.add a b` into a `Prog` that returns the sum. -/ +@[expose] def doAdd (a b : α) : Prog (ArithQuery α) α := .liftBind (.add a b) .pure +/-- Lift `ArithQuery.sub a b` into a `Prog` that returns the difference. -/ +@[expose] def doSub (a b : α) : Prog (ArithQuery α) α := .liftBind (.sub a b) .pure +/-- Lift `ArithQuery.mul a b` into a `Prog` that returns the product. -/ +@[expose] def doMul (a b : α) : Prog (ArithQuery α) α := .liftBind (.mul a b) .pure + +/-- An honest oracle interprets arithmetic queries using the actual ring operations. -/ +@[expose] def honest [Add α] [Sub α] [Mul α] {ι : Type} : ArithQuery α ι → ι + | .add a b => a + b + | .sub a b => a - b + | .mul a b => a * b + +/-- Weighted cost model for arithmetic queries. Subtraction costs the same as addition + (both are linear-time on bignums). -/ +@[expose] def weight (c_add c_mul : Nat) {ι : Type} : ArithQuery α ι → Nat + | .add _ _ => c_add + | .sub _ _ => c_add + | .mul _ _ => c_mul + +end ArithQuery + +/-- Naive complex multiplication: `(a + bi)(c + di) = (ac - bd) + (ad + bc)i`. + Uses 4 multiplications, 1 subtraction, 1 addition. -/ +@[expose] def complexMulNaive (a b c d : α) : Prog (ArithQuery α) (α × α) := do + let ac ← ArithQuery.doMul a c + let bd ← ArithQuery.doMul b d + let ad ← ArithQuery.doMul a d + let bc ← ArithQuery.doMul b c + let real ← ArithQuery.doSub ac bd + let imag ← ArithQuery.doAdd ad bc + pure (real, imag) + +/-- Gauss's trick for complex multiplication: computes `(a+b)(c+d)` to save one + multiplication, at the cost of extra additions and subtractions. + Uses 3 multiplications, 2 subtractions, 2 additions. -/ +@[expose] def complexMulGauss (a b c d : α) : Prog (ArithQuery α) (α × α) := do + let ac ← ArithQuery.doMul a c + let bd ← ArithQuery.doMul b d + let apb ← ArithQuery.doAdd a b + let cpd ← ArithQuery.doAdd c d + let abcd ← ArithQuery.doMul apb cpd + let real ← ArithQuery.doSub ac bd + let imag ← ArithQuery.doSub abcd (← ArithQuery.doAdd ac bd) + pure (real, imag) + +end Cslib.Query + +end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean new file mode 100644 index 000000000..69b1fad60 --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison +-/ +module + +public import Cslib.Algorithms.Lean.Query.Arith.Defs +import Mathlib.Tactic.Ring +public import Mathlib.Algebra.Ring.Defs + +/-! # Complex Multiplication: Correctness and Cost Analysis + +We prove that both `complexMulNaive` and `complexMulGauss` correctly compute +complex multiplication when given an honest oracle, and compute their exact +costs under a parametric weight function. + +The cost theorems hold for *any* oracle (not just honest ones), because both +algorithms are straight-line (no branching on query results). The correctness +theorems require the honest oracle. +-/ + +open Cslib.Query + +public section + +namespace Cslib.Query + +variable {α : Type} + +-- ## Correctness + +theorem complexMulNaive_eval_honest [Ring α] (a b c d : α) : + (complexMulNaive a b c d).eval ArithQuery.honest = (a * c - b * d, a * d + b * c) := by + simp [complexMulNaive, ArithQuery.doMul, ArithQuery.doSub, ArithQuery.doAdd, ArithQuery.honest] + +theorem complexMulGauss_eval_honest [CommRing α] (a b c d : α) : + (complexMulGauss a b c d).eval ArithQuery.honest = (a * c - b * d, a * d + b * c) := by + simp [complexMulGauss, ArithQuery.doMul, ArithQuery.doSub, ArithQuery.doAdd, ArithQuery.honest] + ring + +-- ## Exact cost counts + +theorem complexMulNaive_cost (oracle : {ι : Type} → ArithQuery α ι → ι) + (c_add c_mul : Nat) (a b c d : α) : + (complexMulNaive a b c d).cost oracle (ArithQuery.weight c_add c_mul) = + 4 * c_mul + 2 * c_add := by + simp [complexMulNaive, ArithQuery.doMul, ArithQuery.doSub, ArithQuery.doAdd, ArithQuery.weight] + omega + +theorem complexMulGauss_cost (oracle : {ι : Type} → ArithQuery α ι → ι) + (c_add c_mul : Nat) (a b c d : α) : + (complexMulGauss a b c d).cost oracle (ArithQuery.weight c_add c_mul) = + 3 * c_mul + 5 * c_add := by + simp [complexMulGauss, ArithQuery.doMul, ArithQuery.doSub, ArithQuery.doAdd, ArithQuery.weight] + omega + +-- ## Crossover: Gauss beats naive when multiplication costs more than 3× addition + +theorem gauss_le_naive (c_add c_mul : Nat) (h : 3 * c_add ≤ c_mul) : + 3 * c_mul + 5 * c_add ≤ 4 * c_mul + 2 * c_add := by omega + +theorem gauss_le_naive_iff (c_add c_mul : Nat) : + 3 * c_mul + 5 * c_add ≤ 4 * c_mul + 2 * c_add ↔ 3 * c_add ≤ c_mul := by omega + +end Cslib.Query + +end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Prog.lean b/Cslib/Algorithms/Lean/Query/Prog.lean index d135ca491..c2bc5ed72 100644 --- a/Cslib/Algorithms/Lean/Query/Prog.lean +++ b/Cslib/Algorithms/Lean/Query/Prog.lean @@ -85,6 +85,39 @@ variable {Q : Type → Type} {α β : Type} simp only [FreeM.bind, queriesOn_liftBind, eval_liftBind, ih (oracle op)] omega +/-- Weighted query cost: each query has a cost given by `weight`. -/ +@[expose] def cost (oracle : {ι : Type} → Q ι → ι) + (weight : {ι : Type} → Q ι → Nat) : Prog Q α → Nat + | .pure _ => 0 + | .liftBind op cont => weight op + cost oracle weight (cont (oracle op)) + +-- Simp lemmas for cost + +@[simp] theorem cost_pure (oracle : {ι : Type} → Q ι → ι) + (weight : {ι : Type} → Q ι → Nat) (a : α) : + cost oracle weight (.pure a : Prog Q α) = 0 := rfl + +@[simp] theorem cost_liftBind (oracle : {ι : Type} → Q ι → ι) + (weight : {ι : Type} → Q ι → Nat) {ι : Type} (op : Q ι) (cont : ι → Prog Q α) : + cost oracle weight (.liftBind op cont) = + weight op + cost oracle weight (cont (oracle op)) := rfl + +@[simp] theorem cost_bind (oracle : {ι : Type} → Q ι → ι) + (weight : {ι : Type} → Q ι → Nat) (t : Prog Q α) (f : α → Prog Q β) : + cost oracle weight (t.bind f) = + cost oracle weight t + cost oracle weight (f (eval oracle t)) := by + induction t with + | pure a => simp [FreeM.bind] + | liftBind op cont ih => + simp only [FreeM.bind, cost_liftBind, eval_liftBind, ih (oracle op)] + omega + +theorem queriesOn_eq_cost_one (oracle : {ι : Type} → Q ι → ι) (p : Prog Q α) : + queriesOn oracle p = cost oracle (fun _ => 1) p := by + induction p with + | pure a => rfl + | liftBind op cont ih => simp [ih (oracle op)] + end Prog end Cslib.Query From 7327006620c8122aecb4be6a6ade777b41e38430 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Thu, 5 Mar 2026 09:06:52 +0000 Subject: [PATCH 45/75] docs(Query/Arith): clarify these are toy examples of parametrized costs Co-Authored-By: Claude Opus 4.6 Co-authored-by: Shrys --- Cslib/Algorithms/Lean/Query/Arith/Defs.lean | 11 +++++------ Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean | 10 +++++----- 2 files changed, 10 insertions(+), 11 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Arith/Defs.lean b/Cslib/Algorithms/Lean/Query/Arith/Defs.lean index f32257c08..e7d72ea34 100644 --- a/Cslib/Algorithms/Lean/Query/Arith/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Arith/Defs.lean @@ -9,13 +9,12 @@ public import Cslib.Algorithms.Lean.Query.Prog /-! # Arithmetic Queries and Complex Multiplication -Demonstrates the `Prog.cost` framework with non-uniform query costs. -`ArithQuery α` supports addition, subtraction, and multiplication, each with -independently parametrized costs. +A simple example showing how to use `Prog.cost` with variable/parametrized query costs. -The motivating example is complex number multiplication, where two algorithms -(naive and Gauss's trick) trade multiplications for additions. With parametric -costs `c_add` and `c_mul`, the optimal choice depends on their ratio. +`ArithQuery α` supports addition, subtraction, and multiplication, each with +independently parametrized costs. Complex number multiplication provides a toy example +where two algorithms (naive and Gauss's trick) trade multiplications for additions, +and the optimal choice depends on the cost ratio. -/ open Cslib.Query diff --git a/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean index 69b1fad60..75ce0a857 100644 --- a/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean @@ -11,13 +11,13 @@ public import Mathlib.Algebra.Ring.Defs /-! # Complex Multiplication: Correctness and Cost Analysis +A simple example showing how to use `Prog.cost` with variable/parametrized query costs. + We prove that both `complexMulNaive` and `complexMulGauss` correctly compute complex multiplication when given an honest oracle, and compute their exact -costs under a parametric weight function. - -The cost theorems hold for *any* oracle (not just honest ones), because both -algorithms are straight-line (no branching on query results). The correctness -theorems require the honest oracle. +costs under a parametric weight function. The cost theorems hold for *any* oracle +(not just honest ones), because both algorithms are straight-line (no branching +on query results). -/ open Cslib.Query From de06cdf701d35cf60174dabe640d4ba2e8a7816a Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Tue, 28 Apr 2026 02:46:35 +0000 Subject: [PATCH 46/75] refactor(Query): replace Prog with FreeM directly MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Prog Q α was already a definitional `abbrev` for FreeM Q α; this commit deletes the Prog namespace and moves the eval/queriesOn/cost interpreters to a new Cslib/Algorithms/Lean/Query/FreeM.lean. All call sites in the query subtree (sorting, arith examples, bounds) now refer to FreeM directly. One-step query constructors (LEQuery.ask, ArithQuery.doAdd/ doSub/doMul) now use FreeM.lift rather than raw .liftBind … .pure. QueryTree and the Prog→QueryTree bridge (now FreeM.toQueryTree) remain in place; deleting QueryTree requires generalising the lower-bound lemma and lands separately. Co-Authored-By: Claude Opus 4.7 (1M context) --- Cslib.lean | 2 +- Cslib/Algorithms/Lean/Query/Arith/Defs.lean | 22 ++- Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean | 2 +- Cslib/Algorithms/Lean/Query/Bounds.lean | 8 +- Cslib/Algorithms/Lean/Query/FreeM.lean | 115 ++++++++++++++++ Cslib/Algorithms/Lean/Query/Prog.lean | 125 ------------------ .../Lean/Query/Sort/Insertion/Defs.lean | 8 +- .../Lean/Query/Sort/Insertion/Lemmas.lean | 4 +- Cslib/Algorithms/Lean/Query/Sort/IsSort.lean | 8 +- Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean | 12 +- .../Lean/Query/Sort/LowerBound.lean | 60 +++++---- .../Lean/Query/Sort/Merge/Defs.lean | 8 +- .../Lean/Query/Sort/Merge/Lemmas.lean | 4 +- 13 files changed, 185 insertions(+), 193 deletions(-) create mode 100644 Cslib/Algorithms/Lean/Query/FreeM.lean delete mode 100644 Cslib/Algorithms/Lean/Query/Prog.lean diff --git a/Cslib.lean b/Cslib.lean index 79175169d..520468312 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -4,7 +4,7 @@ public import Cslib.Algorithms.Lean.MergeSort.MergeSort public import Cslib.Algorithms.Lean.Query.Arith.Defs public import Cslib.Algorithms.Lean.Query.Arith.Lemmas public import Cslib.Algorithms.Lean.Query.Bounds -public import Cslib.Algorithms.Lean.Query.Prog +public import Cslib.Algorithms.Lean.Query.FreeM public import Cslib.Algorithms.Lean.Query.QueryTree public import Cslib.Algorithms.Lean.Query.Sort.Insertion.Defs public import Cslib.Algorithms.Lean.Query.Sort.Insertion.Lemmas diff --git a/Cslib/Algorithms/Lean/Query/Arith/Defs.lean b/Cslib/Algorithms/Lean/Query/Arith/Defs.lean index e7d72ea34..026a9d762 100644 --- a/Cslib/Algorithms/Lean/Query/Arith/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Arith/Defs.lean @@ -5,11 +5,11 @@ Authors: Kim Morrison -/ module -public import Cslib.Algorithms.Lean.Query.Prog +public import Cslib.Algorithms.Lean.Query.FreeM /-! # Arithmetic Queries and Complex Multiplication -A simple example showing how to use `Prog.cost` with variable/parametrized query costs. +A simple example showing how to use `FreeM.cost` with variable/parametrized query costs. `ArithQuery α` supports addition, subtraction, and multiplication, each with independently parametrized costs. Complex number multiplication provides a toy example @@ -17,8 +17,6 @@ where two algorithms (naive and Gauss's trick) trade multiplications for additio and the optimal choice depends on the cost ratio. -/ -open Cslib.Query - public section namespace Cslib.Query @@ -31,12 +29,12 @@ inductive ArithQuery (α : Type) : Type → Type where namespace ArithQuery -/-- Lift `ArithQuery.add a b` into a `Prog` that returns the sum. -/ -@[expose] def doAdd (a b : α) : Prog (ArithQuery α) α := .liftBind (.add a b) .pure -/-- Lift `ArithQuery.sub a b` into a `Prog` that returns the difference. -/ -@[expose] def doSub (a b : α) : Prog (ArithQuery α) α := .liftBind (.sub a b) .pure -/-- Lift `ArithQuery.mul a b` into a `Prog` that returns the product. -/ -@[expose] def doMul (a b : α) : Prog (ArithQuery α) α := .liftBind (.mul a b) .pure +/-- Lift `ArithQuery.add a b` into a `FreeM` that returns the sum. -/ +@[expose] def doAdd (a b : α) : FreeM (ArithQuery α) α := FreeM.lift (.add a b) +/-- Lift `ArithQuery.sub a b` into a `FreeM` that returns the difference. -/ +@[expose] def doSub (a b : α) : FreeM (ArithQuery α) α := FreeM.lift (.sub a b) +/-- Lift `ArithQuery.mul a b` into a `FreeM` that returns the product. -/ +@[expose] def doMul (a b : α) : FreeM (ArithQuery α) α := FreeM.lift (.mul a b) /-- An honest oracle interprets arithmetic queries using the actual ring operations. -/ @[expose] def honest [Add α] [Sub α] [Mul α] {ι : Type} : ArithQuery α ι → ι @@ -55,7 +53,7 @@ end ArithQuery /-- Naive complex multiplication: `(a + bi)(c + di) = (ac - bd) + (ad + bc)i`. Uses 4 multiplications, 1 subtraction, 1 addition. -/ -@[expose] def complexMulNaive (a b c d : α) : Prog (ArithQuery α) (α × α) := do +@[expose] def complexMulNaive (a b c d : α) : FreeM (ArithQuery α) (α × α) := do let ac ← ArithQuery.doMul a c let bd ← ArithQuery.doMul b d let ad ← ArithQuery.doMul a d @@ -67,7 +65,7 @@ end ArithQuery /-- Gauss's trick for complex multiplication: computes `(a+b)(c+d)` to save one multiplication, at the cost of extra additions and subtractions. Uses 3 multiplications, 2 subtractions, 2 additions. -/ -@[expose] def complexMulGauss (a b c d : α) : Prog (ArithQuery α) (α × α) := do +@[expose] def complexMulGauss (a b c d : α) : FreeM (ArithQuery α) (α × α) := do let ac ← ArithQuery.doMul a c let bd ← ArithQuery.doMul b d let apb ← ArithQuery.doAdd a b diff --git a/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean index 75ce0a857..ee9d0933d 100644 --- a/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean @@ -11,7 +11,7 @@ public import Mathlib.Algebra.Ring.Defs /-! # Complex Multiplication: Correctness and Cost Analysis -A simple example showing how to use `Prog.cost` with variable/parametrized query costs. +A simple example showing how to use `FreeM.cost` with variable/parametrized query costs. We prove that both `complexMulNaive` and `complexMulGauss` correctly compute complex multiplication when given an honest oracle, and compute their exact diff --git a/Cslib/Algorithms/Lean/Query/Bounds.lean b/Cslib/Algorithms/Lean/Query/Bounds.lean index e679be1ec..c6c4771e1 100644 --- a/Cslib/Algorithms/Lean/Query/Bounds.lean +++ b/Cslib/Algorithms/Lean/Query/Bounds.lean @@ -5,7 +5,7 @@ Authors: Sebastian Graf, Kim Morrison, Shreyas Srinivas -/ module -public import Cslib.Algorithms.Lean.Query.Prog +public import Cslib.Algorithms.Lean.Query.FreeM /-! # Upper and Lower Bounds for Query Complexity @@ -13,21 +13,19 @@ Definitions of upper and lower bounds on the number of queries a program makes, quantified over oracles. -/ -open Cslib.Query - public section namespace Cslib.Query /-- Upper bound: for all oracles, inputs of size ≤ n make at most `bound n` queries. -/ -@[expose] def UpperBound (prog : α → Prog Q β) +@[expose] def UpperBound (prog : α → FreeM Q β) (size : α → Nat) (bound : Nat → Nat) : Prop := ∀ (oracle : {ι : Type} → Q ι → ι) (n : Nat) (x : α), size x ≤ n → (prog x).queriesOn oracle ≤ bound n /-- Lower bound: for every size n, there exists an input and oracle making the program perform ≥ `bound n` queries. -/ -@[expose] def LowerBound (prog : α → Prog Q β) +@[expose] def LowerBound (prog : α → FreeM Q β) (size : α → Nat) (bound : Nat → Nat) : Prop := ∀ (n : Nat), ∃ (x : α), size x ≤ n ∧ ∃ (oracle : {ι : Type} → Q ι → ι), bound n ≤ (prog x).queriesOn oracle diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean new file mode 100644 index 000000000..f0c961951 --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sebastian Graf, Kim Morrison, Shreyas Srinivas +-/ +module + +public import Cslib.Foundations.Control.Monad.Free + +/-! # FreeM: query/cost interpreters + +This file adds query-complexity interpreters to `FreeM F α`, where the type constructor +`F : Type → Type` represents a query type mapping each query to its response type. + +The key operations are: +- `FreeM.eval oracle p`: evaluate `p` by answering each query using `oracle` +- `FreeM.queriesOn oracle p`: count queries along the oracle-determined path +- `FreeM.cost oracle weight p`: weighted query cost + +Because the oracle is supplied *after* the program produces its query plan (the `FreeM` tree), +a sound implementation has no way to "guess" what the oracle would respond. This is the +foundation of the anti-cheating guarantee for both upper and lower bounds. + +This provides an alternative to the `TimeM`-based cost analysis in +`Cslib.Algorithms.Lean.MergeSort`: here query counting is structural (derived from the +`FreeM` tree) rather than annotation-based. +-/ + +public section + +namespace Cslib.FreeM + +variable {F : Type → Type} {α β : Type} + +/-- Evaluate a program by answering each query using `oracle`. -/ +@[expose] def eval (oracle : {ι : Type} → F ι → ι) : FreeM F α → α + | .pure a => a + | .liftBind op cont => eval oracle (cont (oracle op)) + +/-- Count the number of queries along the path determined by `oracle`. -/ +@[expose] def queriesOn (oracle : {ι : Type} → F ι → ι) : FreeM F α → Nat + | .pure _ => 0 + | .liftBind op cont => 1 + queriesOn oracle (cont (oracle op)) + +-- Simp lemmas for eval + +@[simp] theorem eval_pure (oracle : {ι : Type} → F ι → ι) (a : α) : + eval oracle (.pure a : FreeM F α) = a := rfl + +@[simp] theorem eval_liftBind (oracle : {ι : Type} → F ι → ι) + {ι : Type} (op : F ι) (cont : ι → FreeM F α) : + eval oracle (.liftBind op cont) = eval oracle (cont (oracle op)) := rfl + +@[simp] theorem eval_bind (oracle : {ι : Type} → F ι → ι) + (t : FreeM F α) (f : α → FreeM F β) : + eval oracle (t.bind f) = eval oracle (f (eval oracle t)) := by + induction t with + | pure a => rfl + | liftBind op cont ih => exact ih (oracle op) + +-- Simp lemmas for queriesOn + +@[simp] theorem queriesOn_pure (oracle : {ι : Type} → F ι → ι) (a : α) : + queriesOn oracle (.pure a : FreeM F α) = 0 := rfl + +@[simp] theorem queriesOn_liftBind (oracle : {ι : Type} → F ι → ι) + {ι : Type} (op : F ι) (cont : ι → FreeM F α) : + queriesOn oracle (.liftBind op cont) = 1 + queriesOn oracle (cont (oracle op)) := rfl + +@[simp] theorem queriesOn_bind (oracle : {ι : Type} → F ι → ι) + (t : FreeM F α) (f : α → FreeM F β) : + queriesOn oracle (t.bind f) = + queriesOn oracle t + queriesOn oracle (f (eval oracle t)) := by + induction t with + | pure a => simp [FreeM.bind] + | liftBind op cont ih => + simp only [FreeM.bind, queriesOn_liftBind, eval_liftBind, ih (oracle op)] + omega + +/-- Weighted query cost: each query has a cost given by `weight`. -/ +@[expose] def cost (oracle : {ι : Type} → F ι → ι) + (weight : {ι : Type} → F ι → Nat) : FreeM F α → Nat + | .pure _ => 0 + | .liftBind op cont => weight op + cost oracle weight (cont (oracle op)) + +-- Simp lemmas for cost + +@[simp] theorem cost_pure (oracle : {ι : Type} → F ι → ι) + (weight : {ι : Type} → F ι → Nat) (a : α) : + cost oracle weight (.pure a : FreeM F α) = 0 := rfl + +@[simp] theorem cost_liftBind (oracle : {ι : Type} → F ι → ι) + (weight : {ι : Type} → F ι → Nat) {ι : Type} (op : F ι) (cont : ι → FreeM F α) : + cost oracle weight (.liftBind op cont) = + weight op + cost oracle weight (cont (oracle op)) := rfl + +@[simp] theorem cost_bind (oracle : {ι : Type} → F ι → ι) + (weight : {ι : Type} → F ι → Nat) (t : FreeM F α) (f : α → FreeM F β) : + cost oracle weight (t.bind f) = + cost oracle weight t + cost oracle weight (f (eval oracle t)) := by + induction t with + | pure a => simp [FreeM.bind] + | liftBind op cont ih => + simp only [FreeM.bind, cost_liftBind, eval_liftBind, ih (oracle op)] + omega + +theorem queriesOn_eq_cost_one (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : + queriesOn oracle p = cost oracle (fun _ => 1) p := by + induction p with + | pure a => rfl + | liftBind op cont ih => simp [ih (oracle op)] + +end Cslib.FreeM + +end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Prog.lean b/Cslib/Algorithms/Lean/Query/Prog.lean deleted file mode 100644 index c2bc5ed72..000000000 --- a/Cslib/Algorithms/Lean/Query/Prog.lean +++ /dev/null @@ -1,125 +0,0 @@ -/- -Copyright (c) 2026 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Sebastian Graf, Kim Morrison, Shreyas Srinivas --/ -module - -public import Cslib.Foundations.Control.Monad.Free - -/-! # Prog: Programs as Free Monads over Query Types - -`Prog Q α` is an alias for `FreeM Q α`, representing a program that makes queries of type `Q` -and returns a result of type `α`. A query type `Q : Type → Type` maps each query to its -response type. - -The key operations are: -- `Prog.eval oracle p`: evaluate `p` by answering each query using `oracle` -- `Prog.queriesOn oracle p`: count the queries along the oracle-determined path - -Because the oracle is supplied *after* the program produces its query plan (the `Prog` tree), -a sound implementation of `prog` has no way to "guess" what the oracle would respond. -This is the foundation of the anti-cheating guarantee for both upper and lower bounds. - -This provides an alternative to the `TimeM`-based cost analysis in -`Cslib.Algorithms.Lean.MergeSort`: here query counting is structural (derived from the -`Prog` tree) rather than annotation-based. --/ - -open Cslib - -public section - -namespace Cslib.Query - -/-- A program that makes queries of type `Q` and returns a result of type `α`. - This is `FreeM Q α`, the free monad over the query type. -/ -abbrev Prog (Q : Type → Type) (α : Type) := FreeM Q α - -namespace Prog - -variable {Q : Type → Type} {α β : Type} - -/-- Evaluate a program by answering each query using `oracle`. -/ -@[expose] def eval (oracle : {ι : Type} → Q ι → ι) : Prog Q α → α - | .pure a => a - | .liftBind op cont => eval oracle (cont (oracle op)) - -/-- Count the number of queries along the path determined by `oracle`. -/ -@[expose] def queriesOn (oracle : {ι : Type} → Q ι → ι) : Prog Q α → Nat - | .pure _ => 0 - | .liftBind op cont => 1 + queriesOn oracle (cont (oracle op)) - --- Simp lemmas for eval - -@[simp] theorem eval_pure (oracle : {ι : Type} → Q ι → ι) (a : α) : - eval oracle (.pure a : Prog Q α) = a := rfl - -@[simp] theorem eval_liftBind (oracle : {ι : Type} → Q ι → ι) - {ι : Type} (op : Q ι) (cont : ι → Prog Q α) : - eval oracle (.liftBind op cont) = eval oracle (cont (oracle op)) := rfl - -@[simp] theorem eval_bind (oracle : {ι : Type} → Q ι → ι) - (t : Prog Q α) (f : α → Prog Q β) : - eval oracle (t.bind f) = eval oracle (f (eval oracle t)) := by - induction t with - | pure a => rfl - | liftBind op cont ih => exact ih (oracle op) - --- Simp lemmas for queriesOn - -@[simp] theorem queriesOn_pure (oracle : {ι : Type} → Q ι → ι) (a : α) : - queriesOn oracle (.pure a : Prog Q α) = 0 := rfl - -@[simp] theorem queriesOn_liftBind (oracle : {ι : Type} → Q ι → ι) - {ι : Type} (op : Q ι) (cont : ι → Prog Q α) : - queriesOn oracle (.liftBind op cont) = 1 + queriesOn oracle (cont (oracle op)) := rfl - -@[simp] theorem queriesOn_bind (oracle : {ι : Type} → Q ι → ι) - (t : Prog Q α) (f : α → Prog Q β) : - queriesOn oracle (t.bind f) = - queriesOn oracle t + queriesOn oracle (f (eval oracle t)) := by - induction t with - | pure a => simp [FreeM.bind] - | liftBind op cont ih => - simp only [FreeM.bind, queriesOn_liftBind, eval_liftBind, ih (oracle op)] - omega - -/-- Weighted query cost: each query has a cost given by `weight`. -/ -@[expose] def cost (oracle : {ι : Type} → Q ι → ι) - (weight : {ι : Type} → Q ι → Nat) : Prog Q α → Nat - | .pure _ => 0 - | .liftBind op cont => weight op + cost oracle weight (cont (oracle op)) - --- Simp lemmas for cost - -@[simp] theorem cost_pure (oracle : {ι : Type} → Q ι → ι) - (weight : {ι : Type} → Q ι → Nat) (a : α) : - cost oracle weight (.pure a : Prog Q α) = 0 := rfl - -@[simp] theorem cost_liftBind (oracle : {ι : Type} → Q ι → ι) - (weight : {ι : Type} → Q ι → Nat) {ι : Type} (op : Q ι) (cont : ι → Prog Q α) : - cost oracle weight (.liftBind op cont) = - weight op + cost oracle weight (cont (oracle op)) := rfl - -@[simp] theorem cost_bind (oracle : {ι : Type} → Q ι → ι) - (weight : {ι : Type} → Q ι → Nat) (t : Prog Q α) (f : α → Prog Q β) : - cost oracle weight (t.bind f) = - cost oracle weight t + cost oracle weight (f (eval oracle t)) := by - induction t with - | pure a => simp [FreeM.bind] - | liftBind op cont ih => - simp only [FreeM.bind, cost_liftBind, eval_liftBind, ih (oracle op)] - omega - -theorem queriesOn_eq_cost_one (oracle : {ι : Type} → Q ι → ι) (p : Prog Q α) : - queriesOn oracle p = cost oracle (fun _ => 1) p := by - induction p with - | pure a => rfl - | liftBind op cont ih => simp [ih (oracle op)] - -end Prog - -end Cslib.Query - -end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean index 64c6d3de3..da387e492 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean @@ -9,17 +9,17 @@ public import Cslib.Algorithms.Lean.Query.Sort.LEQuery /-! # Insertion Sort as a Query Program -Insertion sort implemented as a `Prog (LEQuery α)`, making all comparison queries explicit. +Insertion sort implemented as a `FreeM (LEQuery α)`, making all comparison queries explicit. -/ -open Cslib.Query +open Cslib Cslib.Query public section namespace Cslib.Query /-- Insert `x` into a sorted list using comparison queries. -/ -@[expose] def orderedInsert (x : α) : List α → Prog (LEQuery α) (List α) +@[expose] def orderedInsert (x : α) : List α → FreeM (LEQuery α) (List α) | [] => pure [x] | y :: ys => do let le ← LEQuery.ask x y @@ -30,7 +30,7 @@ namespace Cslib.Query pure (y :: rest) /-- Sort a list using insertion sort with comparison queries. -/ -@[expose] def insertionSort : List α → Prog (LEQuery α) (List α) +@[expose] def insertionSort : List α → FreeM (LEQuery α) (List α) | [] => pure [] | x :: xs => do let sorted ← insertionSort xs diff --git a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean index b566a1d16..96d862211 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean @@ -15,10 +15,10 @@ public import Mathlib.Algebra.Group.Defs /-! # Insertion Sort: Correctness and Upper Bound Proofs that `insertionSort` is a correct comparison sort and uses at most `n²` queries. -All proofs are by plain equational reasoning on `Prog.eval` and `Prog.queriesOn`. +All proofs are by plain equational reasoning on `FreeM.eval` and `FreeM.queriesOn`. -/ -open Cslib.Query +open Cslib Cslib.Query public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean b/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean index 72f435ab1..d71deb3b4 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean @@ -9,20 +9,20 @@ public import Cslib.Algorithms.Lean.Query.Sort.LEQuery /-! # IsSort: Specification for Comparison Sorts -`IsSort sort` asserts that `sort` is a correct comparison sort when viewed as a `Prog` +`IsSort sort` asserts that `sort` is a correct comparison sort when viewed as a `FreeM` over `LEQuery α`. Correctness means: for any oracle, the result is a permutation of the input; and for any oracle implementing a total order, the result is sorted. -/ -open Cslib.Query +open Cslib Cslib.Query public section namespace Cslib.Query -/-- A `Prog`-based function is a correct comparison sort if it always produces a permutation +/-- A `FreeM`-based function is a correct comparison sort if it always produces a permutation of its input, and produces a sorted list when the oracle implements a total order. -/ -structure IsSort (sort : List α → Prog (LEQuery α) (List α)) : Prop where +structure IsSort (sort : List α → FreeM (LEQuery α) (List α)) : Prop where /-- The sort produces a permutation of its input, for any oracle. -/ perm : ∀ (xs : List α) (oracle : {ι : Type} → LEQuery α ι → ι), ((sort xs).eval oracle).Perm xs diff --git a/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean b/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean index 35673f0ec..e7d915316 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean @@ -5,7 +5,7 @@ Authors: Sebastian Graf, Kim Morrison, Shreyas Srinivas -/ module -public import Cslib.Algorithms.Lean.Query.Prog +public import Cslib.Algorithms.Lean.Query.FreeM /-! # LEQuery: Comparison Queries for Sorting @@ -13,8 +13,6 @@ public import Cslib.Algorithms.Lean.Query.Prog A query `LEQuery.le a b` asks whether `a ≤ b` and returns a `Bool`. -/ -open Cslib.Query - public section namespace Cslib.Query @@ -23,12 +21,12 @@ namespace Cslib.Query inductive LEQuery (α : Type) : Type → Type where | le (a b : α) : LEQuery α Bool -/-- Lift `LEQuery.le a b` into a `Prog` that returns the comparison result. -/ -@[expose] def LEQuery.ask (a b : α) : Prog (LEQuery α) Bool := - .liftBind (.le a b) .pure +/-- Lift `LEQuery.le a b` into a `FreeM` that returns the comparison result. -/ +@[expose] def LEQuery.ask (a b : α) : FreeM (LEQuery α) Bool := + FreeM.lift (.le a b) @[simp] theorem LEQuery.eval_ask (oracle : {ι : Type} → LEQuery α ι → ι) (a b : α) : - Prog.eval oracle (LEQuery.ask a b) = oracle (.le a b) := rfl + (LEQuery.ask a b).eval oracle = oracle (.le a b) := rfl end Cslib.Query diff --git a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean index 717a68e46..3384cf249 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean @@ -23,28 +23,28 @@ The proof constructs `n!` distinct total orders on `α` (one per permutation of embedded elements), shows they produce distinct sorted outputs, and applies `QueryTree.exists_queriesOn_ge_clog`. -## Prog-to-QueryTree Bridge +## FreeM-to-QueryTree Bridge -Since `Prog (LEQuery α) β` uses an existentially quantified response type per query (via -`FreeM.liftBind`), while `QueryTree` has a fixed response type `R`, we provide a conversion -`Prog.toQueryTree` that exploits the fact that `LEQuery α` only has one constructor returning -`Bool`. This lets us apply the combinatorial depth lemma on `QueryTree` and transfer results -back to `Prog`. +Since `FreeM (LEQuery α) β` uses an existentially quantified response type per query +(via `FreeM.liftBind`), while `QueryTree` has a fixed response type `R`, we provide a +conversion `FreeM.toQueryTree` that exploits the fact that `LEQuery α` only has one +constructor returning `Bool`. This lets us apply the combinatorial depth lemma on +`QueryTree` and transfer results back to `FreeM`. -/ -open Cslib.Query +open Cslib Cslib.Query public section -namespace Cslib.Query +-- ## FreeM-to-QueryTree bridge for LEQuery --- ## Prog-to-QueryTree bridge for LEQuery +namespace Cslib.Query -/-- Convert a `Prog`-oracle to a `QueryTree`-oracle for `LEQuery`. -/ +/-- Convert a `FreeM`-oracle to a `QueryTree`-oracle for `LEQuery`. -/ @[expose] def toQTOracle (oracle : {ι : Type} → LEQuery α ι → ι) : (α × α) → Bool := fun (a, b) => oracle (.le a b) -/-- Convert a `QueryTree`-oracle to a `Prog`-oracle for `LEQuery`. -/ +/-- Convert a `QueryTree`-oracle to a `FreeM`-oracle for `LEQuery`. -/ @[expose] def fromQTOracle (f : (α × α) → Bool) : {ι : Type} → LEQuery α ι → ι | _, .le a b => f (a, b) @@ -54,29 +54,37 @@ namespace Cslib.Query @[simp] theorem toQTOracle_fromQTOracle (f : (α × α) → Bool) : toQTOracle (fromQTOracle f) = f := rfl -/-- Convert a `Prog (LEQuery α)` program to a `QueryTree (α × α) Bool` decision tree. -/ -@[expose] def Prog.toQueryTree : Prog (LEQuery α) β → QueryTree (α × α) Bool β +end Cslib.Query + +namespace Cslib.FreeM + +/-- Convert a `FreeM (LEQuery α)` program to a `QueryTree (α × α) Bool` decision tree. -/ +@[expose] def toQueryTree : FreeM (LEQuery α) β → QueryTree (α × α) Bool β | .pure a => .pure a - | .liftBind (.le a b) cont => .query (a, b) (fun r => Prog.toQueryTree (cont r)) + | .liftBind (.le a b) cont => .query (a, b) (fun r => toQueryTree (cont r)) -/-- Evaluation is preserved by the Prog-to-QueryTree conversion. -/ -@[simp] theorem Prog.toQueryTree_eval (oracle : {ι : Type} → LEQuery α ι → ι) : - (p : Prog (LEQuery α) β) → +/-- Evaluation is preserved by the FreeM-to-QueryTree conversion. -/ +@[simp] theorem toQueryTree_eval (oracle : {ι : Type} → LEQuery α ι → ι) : + (p : FreeM (LEQuery α) β) → p.toQueryTree.eval (toQTOracle oracle) = p.eval oracle | .pure _ => rfl | .liftBind (.le a b) cont => by - simp only [toQueryTree, QueryTree.eval_query, Prog.eval, toQTOracle] + simp only [toQueryTree, QueryTree.eval_query, FreeM.eval, toQTOracle] exact toQueryTree_eval oracle (cont (oracle (.le a b))) -/-- Query count is preserved by the Prog-to-QueryTree conversion. -/ -@[simp] theorem Prog.toQueryTree_queriesOn (oracle : {ι : Type} → LEQuery α ι → ι) : - (p : Prog (LEQuery α) β) → +/-- Query count is preserved by the FreeM-to-QueryTree conversion. -/ +@[simp] theorem toQueryTree_queriesOn (oracle : {ι : Type} → LEQuery α ι → ι) : + (p : FreeM (LEQuery α) β) → p.toQueryTree.queriesOn (toQTOracle oracle) = p.queriesOn oracle | .pure _ => rfl | .liftBind (.le a b) cont => by - simp only [toQueryTree, QueryTree.queriesOn_query, Prog.queriesOn, toQTOracle] + simp only [toQueryTree, QueryTree.queriesOn_query, FreeM.queriesOn, toQTOracle] exact congrArg (1 + ·) (toQueryTree_queriesOn oracle (cont (oracle (.le a b)))) +end Cslib.FreeM + +namespace Cslib.Query + -- ## infinitePermOrder: constructing n! distinct total orders open Classical in @@ -172,7 +180,7 @@ private theorem map_infinite_embedding_injective [Infinite α] : /-- Any correct comparison sort on an infinite type has query complexity at least `⌈log₂(n!)⌉` for every input size `n`. -/ theorem IsSort.lowerBound_infinite [Infinite α] - {sort : List α → Prog (LEQuery α) (List α)} + {sort : List α → FreeM (LEQuery α) (List α)} (h : IsSort sort) : LowerBound sort List.length (fun n => Nat.clog 2 (Nat.factorial n)) := by intro n @@ -183,7 +191,7 @@ theorem IsSort.lowerBound_infinite [Infinite α] have hcard : Fintype.card (Equiv.Perm (Fin n)) = Nat.factorial n := by rw [Fintype.card_perm, Fintype.card_fin] let e := Fintype.equivFinOfCardEq hcard - -- Define Prog-level oracles, then derive QueryTree oracles from them + -- Define FreeM-level oracles, then derive QueryTree oracles from them let progOracles : Fin (Nat.factorial n) → ({ι : Type} → LEQuery α ι → ι) := fun i => fromQTOracle (fun p => decide (infinitePermOrder n (e.symm i) p.1 p.2)) let qtOracles : Fin (Nat.factorial n) → ((α × α) → Bool) := @@ -193,7 +201,7 @@ theorem IsSort.lowerBound_infinite [Infinite α] intro i j h_eval suffices key : ∀ i, (sort xs).eval (progOracles i) = (List.finRange n).map (fun k => ι ((e.symm i) k).val) by - simp only [tree, qtOracles, Prog.toQueryTree_eval] at h_eval + simp only [tree, qtOracles, FreeM.toQueryTree_eval] at h_eval rw [key, key] at h_eval exact e.symm.injective (map_infinite_embedding_injective h_eval) intro i @@ -206,7 +214,7 @@ theorem IsSort.lowerBound_infinite [Infinite α] -- Apply the depth lemma obtain ⟨i, hi⟩ := QueryTree.exists_queriesOn_ge_clog tree qtOracles (Nat.factorial_pos n) h_inj refine ⟨progOracles i, ?_⟩ - simp only [tree, qtOracles, Prog.toQueryTree_queriesOn] at hi + simp only [tree, qtOracles, FreeM.toQueryTree_queriesOn] at hi exact hi end Cslib.Query diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean index 2f4ce9b4f..9b72d39a7 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean @@ -9,12 +9,12 @@ public import Cslib.Algorithms.Lean.Query.Sort.LEQuery /-! # Merge Sort as a Query Program -Merge sort implemented as a `Prog (LEQuery α)`, making all comparison queries explicit. +Merge sort implemented as a `FreeM (LEQuery α)`, making all comparison queries explicit. Uses an alternating split (odds/evens) to avoid needing `List.length` in the termination argument. -/ -open Cslib.Query +open Cslib Cslib.Query public section @@ -61,7 +61,7 @@ theorem split_snd_length_lt (x y : α) (zs : List α) : simp only [split_snd_length_eq, List.length_cons]; omega /-- Merge two sorted lists using comparison queries. -/ -@[expose] def merge (xs ys : List α) : Prog (LEQuery α) (List α) := +@[expose] def merge (xs ys : List α) : FreeM (LEQuery α) (List α) := match xs, ys with | [], ys => pure ys | xs, [] => pure xs @@ -76,7 +76,7 @@ theorem split_snd_length_lt (x y : α) (zs : List α) : termination_by xs.length + ys.length /-- Sort a list using merge sort with comparison queries. -/ -@[expose] def mergeSort (xs : List α) : Prog (LEQuery α) (List α) := +@[expose] def mergeSort (xs : List α) : FreeM (LEQuery α) (List α) := match xs with | [] => pure [] | [x] => pure [x] diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean index bca7d4dce..ab61d6758 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean @@ -15,10 +15,10 @@ public import Mathlib.Data.Nat.Log /-! # Merge Sort: Correctness and Upper Bound Proofs that `mergeSort` is a correct comparison sort and uses at most `n * ⌈log₂ n⌉` queries. -All proofs are by plain equational reasoning on `Prog.eval` and `Prog.queriesOn`. +All proofs are by plain equational reasoning on `FreeM.eval` and `FreeM.queriesOn`. -/ -open Cslib.Query +open Cslib Cslib.Query public section From b46a15614132bf9a58619b73f9aea9d6bf313cb6 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Tue, 28 Apr 2026 02:59:15 +0000 Subject: [PATCH 47/75] refactor(Query): replace QueryTree with generalised FreeM lower bound MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The QueryTree decision-tree datatype was a single-response-type specialisation of FreeM, kept around because the existing combinatorial lower-bound lemma was easier to state with a fixed response type. This commit ports the lemma directly to FreeM: FreeM.exists_queriesOn_ge_clog : if every response type has cardinality ≤ r, n distinct injective oracles force some oracle to make ≥ ⌈log_r n⌉ queries. The proof mostly mirrors the QueryTree version, using @liftBind to bind the existential response type, and one extra ceiling-division step (Nat.div_le_div_left) to relate the per-node branching factor to the global bound r. Sort/LowerBound.lean now applies the FreeM lemma directly, with LEQuery.fintypeResponse / cardResponse_le_two witnessing that LEQuery responses are always Bool. The Prog→QueryTree bridge (toQTOracle / fromQTOracle / toQueryTree / *_eval / *_queriesOn) is gone; only LEQuery.oracleOf survives, renamed and moved into Sort/LEQuery.lean. Both QueryTree.lean and Sort/QueryTree.lean are deleted. Co-Authored-By: Claude Opus 4.7 (1M context) --- Cslib.lean | 2 - Cslib/Algorithms/Lean/Query/FreeM.lean | 111 +++++++++++++- Cslib/Algorithms/Lean/Query/QueryTree.lean | 140 ------------------ Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean | 19 +++ .../Lean/Query/Sort/LowerBound.lean | 80 ++-------- .../Algorithms/Lean/Query/Sort/QueryTree.lean | 107 ------------- 6 files changed, 140 insertions(+), 319 deletions(-) delete mode 100644 Cslib/Algorithms/Lean/Query/QueryTree.lean delete mode 100644 Cslib/Algorithms/Lean/Query/Sort/QueryTree.lean diff --git a/Cslib.lean b/Cslib.lean index 520468312..26356df03 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -5,7 +5,6 @@ public import Cslib.Algorithms.Lean.Query.Arith.Defs public import Cslib.Algorithms.Lean.Query.Arith.Lemmas public import Cslib.Algorithms.Lean.Query.Bounds public import Cslib.Algorithms.Lean.Query.FreeM -public import Cslib.Algorithms.Lean.Query.QueryTree public import Cslib.Algorithms.Lean.Query.Sort.Insertion.Defs public import Cslib.Algorithms.Lean.Query.Sort.Insertion.Lemmas public import Cslib.Algorithms.Lean.Query.Sort.IsSort @@ -13,7 +12,6 @@ public import Cslib.Algorithms.Lean.Query.Sort.LEQuery public import Cslib.Algorithms.Lean.Query.Sort.LowerBound public import Cslib.Algorithms.Lean.Query.Sort.Merge.Defs public import Cslib.Algorithms.Lean.Query.Sort.Merge.Lemmas -public import Cslib.Algorithms.Lean.Query.Sort.QueryTree public import Cslib.Algorithms.Lean.TimeM public import Cslib.Computability.Automata.Acceptors.Acceptor public import Cslib.Computability.Automata.Acceptors.OmegaAcceptor diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean index f0c961951..711a336e5 100644 --- a/Cslib/Algorithms/Lean/Query/FreeM.lean +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -6,8 +6,12 @@ Authors: Sebastian Graf, Kim Morrison, Shreyas Srinivas module public import Cslib.Foundations.Control.Monad.Free +public import Mathlib.Combinatorics.Pigeonhole +public import Mathlib.Data.Fintype.Card +public import Mathlib.Data.Nat.Log +public import Mathlib.Data.Set.Function -/-! # FreeM: query/cost interpreters +/-! # FreeM: query/cost interpreters and lower-bound lemma This file adds query-complexity interpreters to `FreeM F α`, where the type constructor `F : Type → Type` represents a query type mapping each query to its response type. @@ -24,6 +28,12 @@ foundation of the anti-cheating guarantee for both upper and lower bounds. This provides an alternative to the `TimeM`-based cost analysis in `Cslib.Algorithms.Lean.MergeSort`: here query counting is structural (derived from the `FreeM` tree) rather than annotation-based. + +The combinatorial lower-bound lemma `FreeM.exists_queriesOn_ge_clog` says: if `n` distinct +oracles produce `n` distinct evaluation results from a program whose every response type has +cardinality at most `r`, then some oracle makes at least `⌈log_r n⌉` queries. The proof uses +the adversarial/partition argument: at each query node, the oracles split by their answer, +and the largest fiber still produces distinct results in the corresponding subtree. -/ public section @@ -110,6 +120,105 @@ theorem queriesOn_eq_cost_one (oracle : {ι : Type} → F ι → ι) (p : FreeM | pure a => rfl | liftBind op cont ih => simp [ih (oracle op)] +-- ## Combinatorial lower bound + +section LowerBound + +/-- Finset-based version: if the oracles indexed by `S` produce `|S|`-many distinct + evaluation results, then some oracle in `S` makes at least `⌈log_r |S|⌉` queries. -/ +private theorem exists_mem_queriesOn_ge_clog (r : Nat) + (h_fin : ∀ {ρ : Type}, F ρ → Fintype ρ) + (h_card : ∀ {ρ : Type} (op : F ρ), @Fintype.card ρ (h_fin op) ≤ r) + {ix : Type} (p : FreeM F α) (S : Finset ix) (hS : S.Nonempty) + (oracles : ix → ({ρ : Type} → F ρ → ρ)) + (h_inj : Set.InjOn (fun i => p.eval (oracles i)) ↑S) : + ∃ i ∈ S, p.queriesOn (oracles i) ≥ Nat.clog r S.card := by + classical + induction p generalizing ix S with + | pure a => + obtain ⟨i, hi⟩ := hS + refine ⟨i, hi, ?_⟩ + have hS1 : S.card ≤ 1 := + Finset.card_le_one.mpr fun _ ha _ hb => h_inj ha hb rfl + simp [queriesOn, Nat.clog_of_right_le_one hS1] + | @liftBind ρ op cont ih => + by_cases hle : S.card ≤ 1 + · obtain ⟨i, hi⟩ := hS + exact ⟨i, hi, by simp [Nat.clog_of_right_le_one hle]⟩ + push Not at hle + by_cases hr : r ≤ 1 + · obtain ⟨i, hi⟩ := hS + exact ⟨i, hi, by simp [Nat.clog_of_left_le_one hr]⟩ + push Not at hr + -- 2 ≤ r, 2 ≤ S.card + letI : Fintype ρ := h_fin op + have hk : Fintype.card ρ ≤ r := h_card op + -- Fintype.card ρ ≥ 1: any oracle produces an answer + obtain ⟨i₀, _hi₀⟩ := hS + have : Nonempty ρ := ⟨oracles i₀ op⟩ + have hk1 : 1 ≤ Fintype.card ρ := Fintype.card_pos + -- Pigeonhole: pick fiber of maximum size + have ⟨b, _, hb⟩ : ∃ b ∈ (Finset.univ : Finset ρ), + (S.card - 1) / Fintype.card ρ < + (S.filter (fun i => oracles i op = b)).card := by + apply Finset.exists_lt_card_fiber_of_mul_lt_card_of_maps_to + (fun a _ => Finset.mem_univ (oracles a op)) + simp only [Finset.card_univ] + calc Fintype.card ρ * ((S.card - 1) / Fintype.card ρ) + = (S.card - 1) / Fintype.card ρ * Fintype.card ρ := Nat.mul_comm .. + _ ≤ S.card - 1 := Nat.div_mul_le_self _ _ + _ < S.card := by omega + set S' := S.filter (fun i => oracles i op = b) + have hS' : S'.Nonempty := + Finset.card_pos.mp (Nat.lt_of_le_of_lt (Nat.zero_le _) hb) + have h_inj' : Set.InjOn (fun i => (cont b).eval (oracles i)) ↑S' := by + intro i hi j hj heq + have him := Finset.mem_coe.mp hi |> Finset.mem_filter.mp + have hjm := Finset.mem_coe.mp hj |> Finset.mem_filter.mp + exact h_inj (Finset.mem_coe.mpr him.1) (Finset.mem_coe.mpr hjm.1) + (by simp [eval, him.2, hjm.2, heq]) + obtain ⟨i, hi, hiq⟩ := ih b S' hS' oracles h_inj' + have him := Finset.mem_filter.mp hi + refine ⟨i, him.1, ?_⟩ + simp only [queriesOn_liftBind, him.2] + -- Need: Nat.clog r S.card ≤ 1 + (cont b).queriesOn (oracles i) + have hS'_lb : (S.card + r - 1) / r ≤ S'.card := by + have h1 : (S.card - 1) / r ≤ (S.card - 1) / Fintype.card ρ := + Nat.div_le_div_left hk (by omega) + have h2 : (S.card + r - 1) / r = (S.card - 1) / r + 1 := by + rw [show S.card + r - 1 = S.card - 1 + r from by omega] + exact Nat.add_div_right (S.card - 1) (by omega) + omega + calc Nat.clog r S.card + = 1 + Nat.clog r ((S.card + r - 1) / r) := by + rw [Nat.clog_of_two_le hr (by omega)]; omega + _ ≤ 1 + Nat.clog r S'.card := + Nat.add_le_add_left (Nat.clog_mono_right r hS'_lb) 1 + _ ≤ 1 + (cont b).queriesOn (oracles i) := Nat.add_le_add_left hiq 1 + +/-- If `n` oracles produce `n` distinct evaluation results from a `FreeM F α` program +whose every response type is finite of cardinality at most `r`, then some oracle makes +at least `⌈log_r n⌉` queries. + +This is the core combinatorial lemma for query complexity lower bounds. The proof uses +the adversarial/partition argument: at each query node, the `n` oracles split by their +answer; the largest group (size ≥ ⌈n/r⌉) still produces distinct results in the +corresponding subtree, and the induction proceeds there. -/ +theorem exists_queriesOn_ge_clog (r : Nat) + (h_fin : ∀ {ρ : Type}, F ρ → Fintype ρ) + (h_card : ∀ {ρ : Type} (op : F ρ), @Fintype.card ρ (h_fin op) ≤ r) + (p : FreeM F α) {n : Nat} + (oracles : Fin n → ({ρ : Type} → F ρ → ρ)) + (hn : 0 < n) + (h_inj : Function.Injective (fun i => p.eval (oracles i))) : + ∃ i : Fin n, p.queriesOn (oracles i) ≥ Nat.clog r n := by + have ⟨i, _, hi⟩ := exists_mem_queriesOn_ge_clog r h_fin h_card p Finset.univ + (Finset.univ_nonempty_iff.mpr ⟨⟨0, hn⟩⟩) oracles h_inj.injOn + rw [Finset.card_univ, Fintype.card_fin] at hi + exact ⟨i, hi⟩ + +end LowerBound + end Cslib.FreeM end -- public section diff --git a/Cslib/Algorithms/Lean/Query/QueryTree.lean b/Cslib/Algorithms/Lean/Query/QueryTree.lean deleted file mode 100644 index 60db1768b..000000000 --- a/Cslib/Algorithms/Lean/Query/QueryTree.lean +++ /dev/null @@ -1,140 +0,0 @@ -/- -Copyright (c) 2026 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Sebastian Graf, Kim Morrison, Shreyas Srinivas --/ -module - -public import Cslib.Init -public import Mathlib.Data.Nat.Log -public import Mathlib.Data.Fintype.Card - -/-! # QueryTree: Decision Trees for Query Complexity Lower Bounds - -`QueryTree Q R α` is a free monad specialized to a single query type: queries take -input `Q` and return `R`, with final results of type `α`. It reifies an algorithm's -query pattern as an explicit decision tree. - -The key advantage over `Prog`/`FreeM` for lower bound proofs is that `R` is a fixed type -parameter (not existentially quantified per query), making structural induction with -pigeonhole arguments straightforward. - -## Main Definitions - -- `QueryTree Q R α` — the decision tree type -- `QueryTree.ask` — the canonical single-query tree -- `QueryTree.eval` — evaluate with a specific oracle -- `QueryTree.queriesOn` — count queries along an oracle-determined path --/ - -public section - -namespace Cslib.Query - -/-- A decision tree over queries of type `Q → R`, with results of type `α`. - -This is the free monad specialized to a single fixed-type operation, used to reify -algorithms as explicit trees for query complexity lower bounds. -/ -inductive QueryTree (Q : Type) (R : Type) (α : Type) where - /-- A completed computation returning value `a`. -/ - | pure (a : α) : QueryTree Q R α - /-- A query node: asks query `q`, then continues based on the response. -/ - | query (q : Q) (cont : R → QueryTree Q R α) : QueryTree Q R α - -namespace QueryTree - -variable {Q R α β γ : Type} - -/-- Lift a single query into the tree. -/ -@[expose] def ask (q : Q) : QueryTree Q R R := .query q .pure - -/-- Monadic bind for query trees. -/ -@[expose] protected def bind : QueryTree Q R α → (α → QueryTree Q R β) → QueryTree Q R β - | .pure a, f => f a - | .query q cont, f => .query q (fun r => (cont r).bind f) - -/-- Functorial map for query trees. -/ -@[expose] protected def map (f : α → β) : QueryTree Q R α → QueryTree Q R β - | .pure a => .pure (f a) - | .query q cont => .query q (fun r => (cont r).map f) - -protected theorem bind_pure : ∀ (x : QueryTree Q R α), x.bind .pure = x - | .pure _ => rfl - | .query _ cont => by simp [QueryTree.bind, QueryTree.bind_pure] - -protected theorem bind_assoc : - ∀ (x : QueryTree Q R α) (f : α → QueryTree Q R β) (g : β → QueryTree Q R γ), - (x.bind f).bind g = x.bind (fun a => (f a).bind g) - | .pure _, _, _ => rfl - | .query _ cont, f, g => by simp [QueryTree.bind, QueryTree.bind_assoc] - -protected theorem bind_pure_comp (f : α → β) : - ∀ (x : QueryTree Q R α), x.bind (.pure ∘ f) = x.map f - | .pure _ => rfl - | .query _ cont => by simp [QueryTree.bind, QueryTree.map, QueryTree.bind_pure_comp] - -protected theorem id_map : ∀ (x : QueryTree Q R α), x.map id = x - | .pure _ => rfl - | .query _ cont => by simp [QueryTree.map, QueryTree.id_map] - -instance : Monad (QueryTree Q R) where - pure := .pure - bind := .bind - -instance : LawfulMonad (QueryTree Q R) := LawfulMonad.mk' - (bind_pure_comp := fun _ _ => rfl) - (id_map := QueryTree.bind_pure) - (pure_bind := fun _ _ => rfl) - (bind_assoc := QueryTree.bind_assoc) - --- Core operations - -/-- Evaluate a query tree with a specific oracle, returning the final result. -/ -@[expose] def eval (oracle : Q → R) : QueryTree Q R α → α - | .pure a => a - | .query q cont => eval oracle (cont (oracle q)) - -/-- Count the number of queries along the path determined by `oracle`. -/ -@[expose] def queriesOn (oracle : Q → R) : QueryTree Q R α → Nat - | .pure _ => 0 - | .query q cont => 1 + queriesOn oracle (cont (oracle q)) - --- Simp lemmas - -@[simp] theorem eval_pure' (oracle : Q → R) (a : α) : - (QueryTree.pure a : QueryTree Q R α).eval oracle = a := rfl - -@[simp] theorem eval_query (oracle : Q → R) (q : Q) (cont : R → QueryTree Q R α) : - (QueryTree.query q cont).eval oracle = (cont (oracle q)).eval oracle := rfl - -@[simp] theorem eval_bind (oracle : Q → R) (t : QueryTree Q R α) (f : α → QueryTree Q R β) : - (t.bind f).eval oracle = (f (t.eval oracle)).eval oracle := by - induction t with - | pure a => rfl - | query q cont ih => exact ih (oracle q) - -@[simp] theorem queriesOn_pure' (oracle : Q → R) (a : α) : - (QueryTree.pure a : QueryTree Q R α).queriesOn oracle = 0 := rfl - -@[simp] theorem queriesOn_query (oracle : Q → R) (q : Q) (cont : R → QueryTree Q R α) : - (QueryTree.query q cont).queriesOn oracle = 1 + (cont (oracle q)).queriesOn oracle := rfl - -/-- Queries of `t.bind f` = queries of `t` + queries of the continuation. -/ -@[simp] theorem queriesOn_bind (oracle : Q → R) (t : QueryTree Q R α) (f : α → QueryTree Q R β) : - (t.bind f).queriesOn oracle = - t.queriesOn oracle + (f (t.eval oracle)).queriesOn oracle := by - induction t with - | pure a => simp [QueryTree.bind, queriesOn, eval] - | query q cont ih => simp only [QueryTree.bind, queriesOn_query, eval_query, ih (oracle q)]; omega - -@[simp] theorem queriesOn_ask (oracle : Q → R) (q : Q) : - (ask q : QueryTree Q R R).queriesOn oracle = 1 := rfl - -@[simp] theorem eval_ask (oracle : Q → R) (q : Q) : - (ask q : QueryTree Q R R).eval oracle = oracle q := rfl - -end QueryTree - -end Cslib.Query - -end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean b/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean index e7d915316..d5e4f1970 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean @@ -28,6 +28,25 @@ inductive LEQuery (α : Type) : Type → Type where @[simp] theorem LEQuery.eval_ask (oracle : {ι : Type} → LEQuery α ι → ι) (a b : α) : (LEQuery.ask a b).eval oracle = oracle (.le a b) := rfl +/-- Build an oracle for `LEQuery α` from a binary predicate `α × α → Bool`. -/ +@[expose] def LEQuery.oracleOf (f : α × α → Bool) : {ι : Type} → LEQuery α ι → ι + | _, .le a b => f (a, b) + +@[simp] theorem LEQuery.oracleOf_le (f : α × α → Bool) (a b : α) : + LEQuery.oracleOf f (.le a b) = f (a, b) := rfl + +/-- Every `LEQuery α ι` has response type `ι = Bool`, hence a `Fintype` with cardinality 2. -/ +@[reducible] def LEQuery.fintypeResponse : ∀ {ι : Type}, LEQuery α ι → Fintype ι + | _, .le _ _ => inferInstanceAs (Fintype Bool) + +theorem LEQuery.cardResponse_eq_two : ∀ {ι : Type} (op : LEQuery α ι), + @Fintype.card ι (LEQuery.fintypeResponse op) = 2 + | _, .le _ _ => Fintype.card_bool + +theorem LEQuery.cardResponse_le_two {ι : Type} (op : LEQuery α ι) : + @Fintype.card ι (LEQuery.fintypeResponse op) ≤ 2 := + (LEQuery.cardResponse_eq_two op).le + end Cslib.Query end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean index 3384cf249..12811245d 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean @@ -7,7 +7,6 @@ module public import Cslib.Algorithms.Lean.Query.Bounds public import Cslib.Algorithms.Lean.Query.Sort.IsSort -public import Cslib.Algorithms.Lean.Query.Sort.QueryTree public import Mathlib.Data.List.Sort public import Mathlib.Data.Nat.Factorial.Basic public import Mathlib.Data.Fintype.Perm @@ -21,68 +20,15 @@ has query complexity at least `⌈log₂(n!)⌉` for every input size `n`. The proof constructs `n!` distinct total orders on `α` (one per permutation of `n` embedded elements), shows they produce distinct sorted outputs, and applies -`QueryTree.exists_queriesOn_ge_clog`. - -## FreeM-to-QueryTree Bridge - -Since `FreeM (LEQuery α) β` uses an existentially quantified response type per query -(via `FreeM.liftBind`), while `QueryTree` has a fixed response type `R`, we provide a -conversion `FreeM.toQueryTree` that exploits the fact that `LEQuery α` only has one -constructor returning `Bool`. This lets us apply the combinatorial depth lemma on -`QueryTree` and transfer results back to `FreeM`. +`FreeM.exists_queriesOn_ge_clog` with `LEQuery.fintypeResponse` / +`LEQuery.cardResponse_le_two` witnessing that all responses come from `Bool` +(cardinality 2). -/ open Cslib Cslib.Query public section --- ## FreeM-to-QueryTree bridge for LEQuery - -namespace Cslib.Query - -/-- Convert a `FreeM`-oracle to a `QueryTree`-oracle for `LEQuery`. -/ -@[expose] def toQTOracle (oracle : {ι : Type} → LEQuery α ι → ι) : (α × α) → Bool := - fun (a, b) => oracle (.le a b) - -/-- Convert a `QueryTree`-oracle to a `FreeM`-oracle for `LEQuery`. -/ -@[expose] def fromQTOracle (f : (α × α) → Bool) : {ι : Type} → LEQuery α ι → ι - | _, .le a b => f (a, b) - -@[simp] theorem fromQTOracle_le (f : (α × α) → Bool) (a b : α) : - fromQTOracle f (.le a b) = f (a, b) := rfl - -@[simp] theorem toQTOracle_fromQTOracle (f : (α × α) → Bool) : - toQTOracle (fromQTOracle f) = f := rfl - -end Cslib.Query - -namespace Cslib.FreeM - -/-- Convert a `FreeM (LEQuery α)` program to a `QueryTree (α × α) Bool` decision tree. -/ -@[expose] def toQueryTree : FreeM (LEQuery α) β → QueryTree (α × α) Bool β - | .pure a => .pure a - | .liftBind (.le a b) cont => .query (a, b) (fun r => toQueryTree (cont r)) - -/-- Evaluation is preserved by the FreeM-to-QueryTree conversion. -/ -@[simp] theorem toQueryTree_eval (oracle : {ι : Type} → LEQuery α ι → ι) : - (p : FreeM (LEQuery α) β) → - p.toQueryTree.eval (toQTOracle oracle) = p.eval oracle - | .pure _ => rfl - | .liftBind (.le a b) cont => by - simp only [toQueryTree, QueryTree.eval_query, FreeM.eval, toQTOracle] - exact toQueryTree_eval oracle (cont (oracle (.le a b))) - -/-- Query count is preserved by the FreeM-to-QueryTree conversion. -/ -@[simp] theorem toQueryTree_queriesOn (oracle : {ι : Type} → LEQuery α ι → ι) : - (p : FreeM (LEQuery α) β) → - p.toQueryTree.queriesOn (toQTOracle oracle) = p.queriesOn oracle - | .pure _ => rfl - | .liftBind (.le a b) cont => by - simp only [toQueryTree, QueryTree.queriesOn_query, FreeM.queriesOn, toQTOracle] - exact congrArg (1 + ·) (toQueryTree_queriesOn oracle (cont (oracle (.le a b)))) - -end Cslib.FreeM - namespace Cslib.Query -- ## infinitePermOrder: constructing n! distinct total orders @@ -187,21 +133,17 @@ theorem IsSort.lowerBound_infinite [Infinite α] set ι := Infinite.natEmbedding α refine ⟨(List.finRange n).map (fun i => ι i.val), by simp, ?_⟩ set xs := (List.finRange n).map (fun i => ι i.val) - set tree := (sort xs).toQueryTree have hcard : Fintype.card (Equiv.Perm (Fin n)) = Nat.factorial n := by rw [Fintype.card_perm, Fintype.card_fin] let e := Fintype.equivFinOfCardEq hcard - -- Define FreeM-level oracles, then derive QueryTree oracles from them let progOracles : Fin (Nat.factorial n) → ({ι : Type} → LEQuery α ι → ι) := - fun i => fromQTOracle (fun p => decide (infinitePermOrder n (e.symm i) p.1 p.2)) - let qtOracles : Fin (Nat.factorial n) → ((α × α) → Bool) := - fun i => toQTOracle (progOracles i) + fun i => LEQuery.oracleOf (fun p => decide (infinitePermOrder n (e.symm i) p.1 p.2)) -- Each oracle produces a unique sorted output - have h_inj : Function.Injective (fun i => tree.eval (qtOracles i)) := by + have h_inj : Function.Injective (fun i => (sort xs).eval (progOracles i)) := by intro i j h_eval suffices key : ∀ i, (sort xs).eval (progOracles i) = (List.finRange n).map (fun k => ι ((e.symm i) k).val) by - simp only [tree, qtOracles, FreeM.toQueryTree_eval] at h_eval + dsimp only at h_eval rw [key, key] at h_eval exact e.symm.injective (map_infinite_embedding_injective h_eval) intro i @@ -211,11 +153,11 @@ theorem IsSort.lowerBound_infinite [Infinite α] (fun a b => by simp [progOracles]) exact h_perm.trans (map_perm_of_infinite_embedding (e.symm i)).symm |>.eq_of_pairwise' h_sorted (pairwise_map_infinitePermOrder (e.symm i)) - -- Apply the depth lemma - obtain ⟨i, hi⟩ := QueryTree.exists_queriesOn_ge_clog tree qtOracles (Nat.factorial_pos n) h_inj - refine ⟨progOracles i, ?_⟩ - simp only [tree, qtOracles, FreeM.toQueryTree_queriesOn] at hi - exact hi + -- Apply the FreeM lower-bound lemma directly + obtain ⟨i, hi⟩ := FreeM.exists_queriesOn_ge_clog 2 + LEQuery.fintypeResponse LEQuery.cardResponse_le_two + (sort xs) progOracles (Nat.factorial_pos n) h_inj + exact ⟨progOracles i, hi⟩ end Cslib.Query diff --git a/Cslib/Algorithms/Lean/Query/Sort/QueryTree.lean b/Cslib/Algorithms/Lean/Query/Sort/QueryTree.lean deleted file mode 100644 index fac1e43f4..000000000 --- a/Cslib/Algorithms/Lean/Query/Sort/QueryTree.lean +++ /dev/null @@ -1,107 +0,0 @@ -/- -Copyright (c) 2026 Lean FRO, LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Sebastian Graf, Kim Morrison, Shreyas Srinivas --/ -module - -public import Cslib.Algorithms.Lean.Query.QueryTree -public import Mathlib.Data.Set.Function -public import Mathlib.Combinatorics.Pigeonhole - -/-! # Lower-Bound Lemma for Query Trees - -`QueryTree.exists_queriesOn_ge_clog`: if `n` oracles produce `n` distinct evaluation results -from a query tree with `Fintype` responses, then one of those oracles makes at least -`⌈log_{|R|} n⌉` queries. - -The proof uses the adversarial/partition argument: at each query node, the `n` oracles split by -their answer into `|R|` groups; the largest group (size ≥ ⌈n/|R|⌉) still produces distinct results -in the corresponding subtree, and the induction proceeds there. - -The proof works over an arbitrary `Finset ι` of oracle indices (avoiding re-indexing via -`Fintype.equivFin`), then derives the `Fin n` version as a corollary. --/ - -open Cslib.Query - -public section - -namespace Cslib.Query.QueryTree - -/-- Finset-based version: if the oracles indexed by `S` produce `|S|`-many distinct evaluation - results, then some oracle in `S` makes at least `⌈log_{|R|} |S|⌉` queries. -/ -private theorem exists_mem_queriesOn_ge_clog [Fintype R] - {ι : Type} (t : QueryTree Q R α) (S : Finset ι) (hS : S.Nonempty) - (oracles : ι → (Q → R)) - (h_inj : Set.InjOn (fun i => t.eval (oracles i)) ↑S) : - ∃ i ∈ S, t.queriesOn (oracles i) ≥ Nat.clog (Fintype.card R) S.card := by - classical - induction t generalizing ι S with - | pure a => - obtain ⟨i, hi⟩ := hS - exact ⟨i, hi, by simp [queriesOn, Nat.clog_of_right_le_one - (Finset.card_le_one.mpr fun _ ha _ hb => h_inj ha hb rfl)]⟩ - | query q cont ih => - by_cases hle : S.card ≤ 1 - · obtain ⟨i, hi⟩ := hS; exact ⟨i, hi, by simp [Nat.clog_of_right_le_one hle]⟩ - · push Not at hle - by_cases hR : Fintype.card R ≤ 1 - · obtain ⟨i, hi⟩ := hS; exact ⟨i, hi, by simp [Nat.clog_of_left_le_one hR]⟩ - · push Not at hR - -- Find b : R such that S.filter (oracles · q = b) has ≥ ⌈|S|/|R|⌉ elements - have ⟨b, _, hb⟩ : ∃ b ∈ Finset.univ (α := R), - (S.card - 1) / Fintype.card R < (S.filter (fun i => oracles i q = b)).card := by - apply Finset.exists_lt_card_fiber_of_mul_lt_card_of_maps_to - (fun a _ => Finset.mem_univ (oracles a q)) - simp only [Finset.card_univ] - calc Fintype.card R * ((S.card - 1) / Fintype.card R) - = (S.card - 1) / Fintype.card R * Fintype.card R := Nat.mul_comm .. - _ ≤ S.card - 1 := Nat.div_mul_le_self _ _ - _ < S.card := by omega - set S' := S.filter (fun i => oracles i q = b) - have hS' : S'.Nonempty := - Finset.card_pos.mp (Nat.lt_of_le_of_lt (Nat.zero_le _) hb) - -- Restricted injectivity: eval through query q cont agrees with cont b on S' - have h_inj' : Set.InjOn (fun i => (cont b).eval (oracles i)) ↑S' := by - intro i hi j hj heq - have him := Finset.mem_coe.mp hi |> Finset.mem_filter.mp - have hjm := Finset.mem_coe.mp hj |> Finset.mem_filter.mp - exact h_inj (Finset.mem_coe.mpr him.1) (Finset.mem_coe.mpr hjm.1) - (by simp [eval, him.2, hjm.2, heq]) - obtain ⟨i, hi, hiq⟩ := ih b S' hS' oracles h_inj' - have him := Finset.mem_filter.mp hi - refine ⟨i, him.1, ?_⟩ - simp only [queriesOn_query, him.2] - calc Nat.clog (Fintype.card R) S.card - ≤ 1 + Nat.clog (Fintype.card R) S'.card := by - rw [Nat.clog_of_two_le (by omega) (by omega)] - have h_ceil : (S.card + Fintype.card R - 1) / Fintype.card R = - (S.card - 1) / Fintype.card R + 1 := by - rw [show S.card + Fintype.card R - 1 = S.card - 1 + Fintype.card R from by omega] - exact Nat.add_div_right (S.card - 1) (by omega) - have := Nat.clog_mono_right (Fintype.card R) - (show (S.card + Fintype.card R - 1) / Fintype.card R ≤ S'.card by omega) - omega - _ ≤ 1 + (cont b).queriesOn (oracles i) := by omega - -/-- If `n` oracles produce `n` distinct evaluation results from a query tree with `Fintype` - responses, then one of those oracles makes at least `⌈log_{|R|} n⌉` queries. - - This is the core combinatorial lemma for query complexity lower bounds. - The proof uses the adversarial/partition argument: at each query node, the `n` oracles - split by their answer to the query; the largest group (size ≥ ⌈n/|R|⌉) still produces - distinct results in the corresponding subtree, and the induction proceeds there. -/ -theorem exists_queriesOn_ge_clog [Fintype R] - (t : QueryTree Q R α) (oracles : Fin n → (Q → R)) - (hn : 0 < n) - (h_inj : Function.Injective (fun i => t.eval (oracles i))) : - ∃ i : Fin n, t.queriesOn (oracles i) ≥ Nat.clog (Fintype.card R) n := by - have ⟨i, _, hi⟩ := exists_mem_queriesOn_ge_clog t Finset.univ - (Finset.univ_nonempty_iff.mpr ⟨⟨0, hn⟩⟩) oracles (h_inj.injOn) - rw [Finset.card_univ, Fintype.card_fin] at hi - exact ⟨i, hi⟩ - -end Cslib.Query.QueryTree - -end -- public section From 3bf2acb963ab1d6d0a826c6ae8dfbc26ac7751b3 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Tue, 28 Apr 2026 03:14:43 +0000 Subject: [PATCH 48/75] docs(Query/Arith): fix off-by-strictness in Gauss/naive crossover comment MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The threshold theorem `gauss_le_naive` uses `3 * c_add ≤ c_mul` (inclusive), so the section header should say "at least 3×", not "more than 3×". Co-Authored-By: Claude Opus 4.7 (1M context) --- Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean index ee9d0933d..2df489d9b 100644 --- a/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean @@ -55,7 +55,7 @@ theorem complexMulGauss_cost (oracle : {ι : Type} → ArithQuery α ι → ι) simp [complexMulGauss, ArithQuery.doMul, ArithQuery.doSub, ArithQuery.doAdd, ArithQuery.weight] omega --- ## Crossover: Gauss beats naive when multiplication costs more than 3× addition +-- ## Crossover: Gauss beats naive when multiplication costs at least 3× addition theorem gauss_le_naive (c_add c_mul : Nat) (h : 3 * c_add ≤ c_mul) : 3 * c_mul + 5 * c_add ≤ 4 * c_mul + 2 * c_add := by omega From 3b93bad874c4a37493988fc91c09a39949189e68 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Tue, 28 Apr 2026 03:57:19 +0000 Subject: [PATCH 49/75] refactor(Query/FreeM): route eval, cost, and queriesOn through FreeM.liftM MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Addresses Eric Wieser's review (Mar 5 2026, on the original Prog.lean): "pattern matching on the free monad is exploiting an implementation detail, and that everything should really go through the universal property, FreeM.liftM." All three interpreters are now defined as `liftM` into a target monad: eval : liftM (m := Id) oracle cost : liftM (m := Tally) (fun op => ⟨weight op, oracle op⟩) |>.cost queriesOn : cost oracle (fun _ => 1) where `Tally` is a tiny accumulator monad (a value paired with a `Nat`-valued running cost) introduced in this file with `Monad` and `LawfulMonad` instances. The right primitive turned out to be `def`, not `abbrev`. With `def`, the constructor-form simp lemmas (eval_pure, eval_liftBind, cost_pure, cost_liftBind, queriesOn_pure, queriesOn_liftBind) all reduce by rfl, so downstream proof ergonomics are unchanged from the original pattern-match definitions. simp normal form is determined by the explicit @[simp] theorems rather than opportunistic abbrev unfolding (which would otherwise mix `queriesOn` and `cost _ (fun _ => 1)` forms in goals and confuse omega). Net effect: the universal property is the actual definition, not a post-hoc characterisation. queriesOn_eq_cost_one is rfl. No downstream proof needed updating. Co-Authored-By: Claude Opus 4.7 (1M context) --- Cslib/Algorithms/Lean/Query/FreeM.lean | 104 ++++++++++++++++--------- 1 file changed, 67 insertions(+), 37 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean index 711a336e5..1b874f5fa 100644 --- a/Cslib/Algorithms/Lean/Query/FreeM.lean +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -42,15 +42,58 @@ namespace Cslib.FreeM variable {F : Type → Type} {α β : Type} -/-- Evaluate a program by answering each query using `oracle`. -/ -@[expose] def eval (oracle : {ι : Type} → F ι → ι) : FreeM F α → α - | .pure a => a - | .liftBind op cont => eval oracle (cont (oracle op)) +/-! ## Interpreters + +All three interpreters (`eval`, `cost`, `queriesOn`) are defined as `liftM` interpretations +into target monads, routing them through the universal property of the free monad rather +than direct pattern-match on `FreeM`'s constructors: + +- `eval` interprets into `Id`. +- `cost` interprets into a `Tally` accumulator monad (a value paired with a `Nat`-valued + running cost). +- `queriesOn` is `cost` with unit weight. + +The constructor-form simp lemmas (`eval_pure`, `eval_liftBind`, `cost_pure`, +`cost_liftBind`, `queriesOn_pure`, `queriesOn_liftBind`) all reduce by `rfl`, giving the +same proof ergonomics as direct pattern-match definitions while honouring the universal +property as the primary abstraction. -/ + +/-- Internal accumulator monad: a value paired with a `Nat`-valued running cost. +Used to define `cost` and `queriesOn` via `liftM`. -/ +structure Tally (α : Type) where + cost : Nat + val : α + +instance : Monad Tally where + pure a := ⟨0, a⟩ + bind x f := ⟨x.cost + (f x.val).cost, (f x.val).val⟩ + +instance : LawfulMonad Tally := LawfulMonad.mk' + (id_map := fun ⟨n, _⟩ => by + change Tally.mk (n + 0) _ = Tally.mk n _ + simp) + (pure_bind := fun a f => by + change Tally.mk (0 + (f a).cost) (f a).val = f a + cases f a + simp) + (bind_assoc := fun ⟨_, _⟩ _ _ => by + change Tally.mk _ _ = Tally.mk _ _ + simp [Bind.bind, Nat.add_assoc]) + +/-- Evaluate a program by answering each query using `oracle`. +Defined as `liftM` to `Id`, the canonical interpreter into pure values. -/ +@[expose] def eval (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : α := + p.liftM (m := Id) oracle + +/-- Weighted query cost: each query has a cost given by `weight`, accumulated along the +oracle-determined path. Defined as `liftM` into the accumulator monad `Tally`. -/ +@[expose] def cost (oracle : {ι : Type} → F ι → ι) + (weight : {ι : Type} → F ι → Nat) (p : FreeM F α) : Nat := + (p.liftM (m := Tally) (fun op => ⟨weight op, oracle op⟩)).cost /-- Count the number of queries along the path determined by `oracle`. -/ -@[expose] def queriesOn (oracle : {ι : Type} → F ι → ι) : FreeM F α → Nat - | .pure _ => 0 - | .liftBind op cont => 1 + queriesOn oracle (cont (oracle op)) +@[expose] def queriesOn (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : Nat := + cost oracle (fun _ => 1) p -- Simp lemmas for eval @@ -68,31 +111,6 @@ variable {F : Type → Type} {α β : Type} | pure a => rfl | liftBind op cont ih => exact ih (oracle op) --- Simp lemmas for queriesOn - -@[simp] theorem queriesOn_pure (oracle : {ι : Type} → F ι → ι) (a : α) : - queriesOn oracle (.pure a : FreeM F α) = 0 := rfl - -@[simp] theorem queriesOn_liftBind (oracle : {ι : Type} → F ι → ι) - {ι : Type} (op : F ι) (cont : ι → FreeM F α) : - queriesOn oracle (.liftBind op cont) = 1 + queriesOn oracle (cont (oracle op)) := rfl - -@[simp] theorem queriesOn_bind (oracle : {ι : Type} → F ι → ι) - (t : FreeM F α) (f : α → FreeM F β) : - queriesOn oracle (t.bind f) = - queriesOn oracle t + queriesOn oracle (f (eval oracle t)) := by - induction t with - | pure a => simp [FreeM.bind] - | liftBind op cont ih => - simp only [FreeM.bind, queriesOn_liftBind, eval_liftBind, ih (oracle op)] - omega - -/-- Weighted query cost: each query has a cost given by `weight`. -/ -@[expose] def cost (oracle : {ι : Type} → F ι → ι) - (weight : {ι : Type} → F ι → Nat) : FreeM F α → Nat - | .pure _ => 0 - | .liftBind op cont => weight op + cost oracle weight (cont (oracle op)) - -- Simp lemmas for cost @[simp] theorem cost_pure (oracle : {ι : Type} → F ι → ι) @@ -114,11 +132,23 @@ variable {F : Type → Type} {α β : Type} simp only [FreeM.bind, cost_liftBind, eval_liftBind, ih (oracle op)] omega +-- Simp lemmas for queriesOn + +@[simp] theorem queriesOn_pure (oracle : {ι : Type} → F ι → ι) (a : α) : + queriesOn oracle (.pure a : FreeM F α) = 0 := rfl + +@[simp] theorem queriesOn_liftBind (oracle : {ι : Type} → F ι → ι) + {ι : Type} (op : F ι) (cont : ι → FreeM F α) : + queriesOn oracle (.liftBind op cont) = 1 + queriesOn oracle (cont (oracle op)) := rfl + +@[simp] theorem queriesOn_bind (oracle : {ι : Type} → F ι → ι) + (t : FreeM F α) (f : α → FreeM F β) : + queriesOn oracle (t.bind f) = + queriesOn oracle t + queriesOn oracle (f (eval oracle t)) := + cost_bind oracle (fun _ => 1) t f + theorem queriesOn_eq_cost_one (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : - queriesOn oracle p = cost oracle (fun _ => 1) p := by - induction p with - | pure a => rfl - | liftBind op cont ih => simp [ih (oracle op)] + queriesOn oracle p = cost oracle (fun _ => 1) p := rfl -- ## Combinatorial lower bound @@ -176,7 +206,7 @@ private theorem exists_mem_queriesOn_ge_clog (r : Nat) have him := Finset.mem_coe.mp hi |> Finset.mem_filter.mp have hjm := Finset.mem_coe.mp hj |> Finset.mem_filter.mp exact h_inj (Finset.mem_coe.mpr him.1) (Finset.mem_coe.mpr hjm.1) - (by simp [eval, him.2, hjm.2, heq]) + (by simp [him.2, hjm.2, heq]) obtain ⟨i, hi, hiq⟩ := ih b S' hS' oracles h_inj' have him := Finset.mem_filter.mp hi refine ⟨i, him.1, ?_⟩ From 2dc7d9f4f0a21e6bd808e15d865f3cdb43b6b173 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Tue, 28 Apr 2026 04:50:14 +0000 Subject: [PATCH 50/75] docs(Query/FreeM): add field docstrings to Tally to satisfy docBlame linter Co-Authored-By: Claude Opus 4.7 (1M context) --- Cslib/Algorithms/Lean/Query/FreeM.lean | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean index 1b874f5fa..72d0b7001 100644 --- a/Cslib/Algorithms/Lean/Query/FreeM.lean +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -61,7 +61,9 @@ property as the primary abstraction. -/ /-- Internal accumulator monad: a value paired with a `Nat`-valued running cost. Used to define `cost` and `queriesOn` via `liftM`. -/ structure Tally (α : Type) where + /-- Running cost accumulated so far. -/ cost : Nat + /-- The carried value. -/ val : α instance : Monad Tally where From 391cab007c5c056af9ab874e450fc91a9e9daee5 Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Wed, 29 Apr 2026 00:34:03 +0000 Subject: [PATCH 51/75] drop Tally --- Cslib/Algorithms/Lean/Query/FreeM.lean | 35 ++++++-------------------- 1 file changed, 7 insertions(+), 28 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean index 72d0b7001..2d85ca6e9 100644 --- a/Cslib/Algorithms/Lean/Query/FreeM.lean +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -6,6 +6,7 @@ Authors: Sebastian Graf, Kim Morrison, Shreyas Srinivas module public import Cslib.Foundations.Control.Monad.Free +public import Cslib.Algorithms.Lean.TimeM public import Mathlib.Combinatorics.Pigeonhole public import Mathlib.Data.Fintype.Card public import Mathlib.Data.Nat.Log @@ -38,6 +39,8 @@ and the largest fiber still produces distinct results in the corresponding subtr public section +open Cslib.Algorithms.Lean (TimeM) + namespace Cslib.FreeM variable {F : Type → Type} {α β : Type} @@ -49,7 +52,7 @@ into target monads, routing them through the universal property of the free mona than direct pattern-match on `FreeM`'s constructors: - `eval` interprets into `Id`. -- `cost` interprets into a `Tally` accumulator monad (a value paired with a `Nat`-valued +- `cost` interprets into a `TimeM` accumulator monad (a value paired with a `Nat`-valued running cost). - `queriesOn` is `cost` with unit weight. @@ -58,40 +61,16 @@ The constructor-form simp lemmas (`eval_pure`, `eval_liftBind`, `cost_pure`, same proof ergonomics as direct pattern-match definitions while honouring the universal property as the primary abstraction. -/ -/-- Internal accumulator monad: a value paired with a `Nat`-valued running cost. -Used to define `cost` and `queriesOn` via `liftM`. -/ -structure Tally (α : Type) where - /-- Running cost accumulated so far. -/ - cost : Nat - /-- The carried value. -/ - val : α - -instance : Monad Tally where - pure a := ⟨0, a⟩ - bind x f := ⟨x.cost + (f x.val).cost, (f x.val).val⟩ - -instance : LawfulMonad Tally := LawfulMonad.mk' - (id_map := fun ⟨n, _⟩ => by - change Tally.mk (n + 0) _ = Tally.mk n _ - simp) - (pure_bind := fun a f => by - change Tally.mk (0 + (f a).cost) (f a).val = f a - cases f a - simp) - (bind_assoc := fun ⟨_, _⟩ _ _ => by - change Tally.mk _ _ = Tally.mk _ _ - simp [Bind.bind, Nat.add_assoc]) - /-- Evaluate a program by answering each query using `oracle`. Defined as `liftM` to `Id`, the canonical interpreter into pure values. -/ @[expose] def eval (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : α := - p.liftM (m := Id) oracle + Id.run <| p.liftM fun i => pure (oracle i) /-- Weighted query cost: each query has a cost given by `weight`, accumulated along the -oracle-determined path. Defined as `liftM` into the accumulator monad `Tally`. -/ +oracle-determined path. Defined as `liftM` into the accumulator monad `TimeM`. -/ @[expose] def cost (oracle : {ι : Type} → F ι → ι) (weight : {ι : Type} → F ι → Nat) (p : FreeM F α) : Nat := - (p.liftM (m := Tally) (fun op => ⟨weight op, oracle op⟩)).cost + TimeM.time <| p.liftM fun op => ⟨oracle op, weight op⟩ /-- Count the number of queries along the path determined by `oracle`. -/ @[expose] def queriesOn (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : Nat := From 6fdf909a40a4e514a176855a573fe1741eb1e695 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Thu, 27 Aug 2026 14:24:48 +1000 Subject: [PATCH 52/75] refactor(Query): address review feedback --- Cslib/Algorithms/Lean/Query/Arith/Defs.lean | 10 +- Cslib/Algorithms/Lean/Query/Bounds.lean | 4 +- Cslib/Algorithms/Lean/Query/FreeM.lean | 79 ++++++------- .../Lean/Query/Sort/Insertion/Defs.lean | 8 +- .../Lean/Query/Sort/Insertion/Lemmas.lean | 110 +++++++----------- Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean | 2 +- .../Lean/Query/Sort/LowerBound.lean | 4 +- .../Lean/Query/Sort/Merge/Defs.lean | 19 +-- .../Lean/Query/Sort/Merge/Lemmas.lean | 56 ++++----- 9 files changed, 132 insertions(+), 160 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Arith/Defs.lean b/Cslib/Algorithms/Lean/Query/Arith/Defs.lean index 026a9d762..0da62a578 100644 --- a/Cslib/Algorithms/Lean/Query/Arith/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Arith/Defs.lean @@ -30,11 +30,11 @@ inductive ArithQuery (α : Type) : Type → Type where namespace ArithQuery /-- Lift `ArithQuery.add a b` into a `FreeM` that returns the sum. -/ -@[expose] def doAdd (a b : α) : FreeM (ArithQuery α) α := FreeM.lift (.add a b) +abbrev doAdd (a b : α) : FreeM (ArithQuery α) α := FreeM.lift (.add a b) /-- Lift `ArithQuery.sub a b` into a `FreeM` that returns the difference. -/ -@[expose] def doSub (a b : α) : FreeM (ArithQuery α) α := FreeM.lift (.sub a b) +abbrev doSub (a b : α) : FreeM (ArithQuery α) α := FreeM.lift (.sub a b) /-- Lift `ArithQuery.mul a b` into a `FreeM` that returns the product. -/ -@[expose] def doMul (a b : α) : FreeM (ArithQuery α) α := FreeM.lift (.mul a b) +abbrev doMul (a b : α) : FreeM (ArithQuery α) α := FreeM.lift (.mul a b) /-- An honest oracle interprets arithmetic queries using the actual ring operations. -/ @[expose] def honest [Add α] [Sub α] [Mul α] {ι : Type} : ArithQuery α ι → ι @@ -60,7 +60,7 @@ end ArithQuery let bc ← ArithQuery.doMul b c let real ← ArithQuery.doSub ac bd let imag ← ArithQuery.doAdd ad bc - pure (real, imag) + return (real, imag) /-- Gauss's trick for complex multiplication: computes `(a+b)(c+d)` to save one multiplication, at the cost of extra additions and subtractions. @@ -73,7 +73,7 @@ end ArithQuery let abcd ← ArithQuery.doMul apb cpd let real ← ArithQuery.doSub ac bd let imag ← ArithQuery.doSub abcd (← ArithQuery.doAdd ac bd) - pure (real, imag) + return (real, imag) end Cslib.Query diff --git a/Cslib/Algorithms/Lean/Query/Bounds.lean b/Cslib/Algorithms/Lean/Query/Bounds.lean index c6c4771e1..964412803 100644 --- a/Cslib/Algorithms/Lean/Query/Bounds.lean +++ b/Cslib/Algorithms/Lean/Query/Bounds.lean @@ -21,14 +21,14 @@ namespace Cslib.Query @[expose] def UpperBound (prog : α → FreeM Q β) (size : α → Nat) (bound : Nat → Nat) : Prop := ∀ (oracle : {ι : Type} → Q ι → ι) (n : Nat) (x : α), - size x ≤ n → (prog x).queriesOn oracle ≤ bound n + size x ≤ n → (prog x).countQueries oracle ≤ bound n /-- Lower bound: for every size n, there exists an input and oracle making the program perform ≥ `bound n` queries. -/ @[expose] def LowerBound (prog : α → FreeM Q β) (size : α → Nat) (bound : Nat → Nat) : Prop := ∀ (n : Nat), ∃ (x : α), size x ≤ n ∧ - ∃ (oracle : {ι : Type} → Q ι → ι), bound n ≤ (prog x).queriesOn oracle + ∃ (oracle : {ι : Type} → Q ι → ι), bound n ≤ (prog x).countQueries oracle end Cslib.Query diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean index 2d85ca6e9..90c26567a 100644 --- a/Cslib/Algorithms/Lean/Query/FreeM.lean +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -19,8 +19,8 @@ This file adds query-complexity interpreters to `FreeM F α`, where the type con The key operations are: - `FreeM.eval oracle p`: evaluate `p` by answering each query using `oracle` -- `FreeM.queriesOn oracle p`: count queries along the oracle-determined path -- `FreeM.cost oracle weight p`: weighted query cost +- `FreeM.countQueries oracle p`: count queries along the oracle-determined path +- `FreeM.cost oracle weight p`: weighted query cost in any additive monoid Because the oracle is supplied *after* the program produces its query plan (the `FreeM` tree), a sound implementation has no way to "guess" what the oracle would respond. This is the @@ -30,7 +30,7 @@ This provides an alternative to the `TimeM`-based cost analysis in `Cslib.Algorithms.Lean.MergeSort`: here query counting is structural (derived from the `FreeM` tree) rather than annotation-based. -The combinatorial lower-bound lemma `FreeM.exists_queriesOn_ge_clog` says: if `n` distinct +The combinatorial lower-bound lemma `FreeM.exists_countQueries_ge_clog` says: if `n` distinct oracles produce `n` distinct evaluation results from a program whose every response type has cardinality at most `r`, then some oracle makes at least `⌈log_r n⌉` queries. The proof uses the adversarial/partition argument: at each query node, the oracles split by their answer, @@ -47,17 +47,17 @@ variable {F : Type → Type} {α β : Type} /-! ## Interpreters -All three interpreters (`eval`, `cost`, `queriesOn`) are defined as `liftM` interpretations +All three interpreters (`eval`, `cost`, `countQueries`) are defined as `liftM` interpretations into target monads, routing them through the universal property of the free monad rather than direct pattern-match on `FreeM`'s constructors: - `eval` interprets into `Id`. -- `cost` interprets into a `TimeM` accumulator monad (a value paired with a `Nat`-valued - running cost). -- `queriesOn` is `cost` with unit weight. +- `cost` interprets into a `TimeM` accumulator monad (a value paired with a running cost in + an arbitrary additive monoid). +- `countQueries` is `cost` with unit weight. The constructor-form simp lemmas (`eval_pure`, `eval_liftBind`, `cost_pure`, -`cost_liftBind`, `queriesOn_pure`, `queriesOn_liftBind`) all reduce by `rfl`, giving the +`cost_liftBind`, `countQueries_pure`, `countQueries_liftBind`) all reduce by `rfl`, giving the same proof ergonomics as direct pattern-match definitions while honouring the universal property as the primary abstraction. -/ @@ -66,14 +66,14 @@ Defined as `liftM` to `Id`, the canonical interpreter into pure values. -/ @[expose] def eval (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : α := Id.run <| p.liftM fun i => pure (oracle i) -/-- Weighted query cost: each query has a cost given by `weight`, accumulated along the -oracle-determined path. Defined as `liftM` into the accumulator monad `TimeM`. -/ -@[expose] def cost (oracle : {ι : Type} → F ι → ι) - (weight : {ι : Type} → F ι → Nat) (p : FreeM F α) : Nat := +/-- Weighted query cost in an additive monoid: each query has a cost given by `weight`, +accumulated along the oracle-determined path. Defined as `liftM` into `TimeM`. -/ +@[expose] def cost {T : Type} [AddMonoid T] (oracle : {ι : Type} → F ι → ι) + (weight : {ι : Type} → F ι → T) (p : FreeM F α) : T := TimeM.time <| p.liftM fun op => ⟨oracle op, weight op⟩ /-- Count the number of queries along the path determined by `oracle`. -/ -@[expose] def queriesOn (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : Nat := +@[expose] def countQueries (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : Nat := cost oracle (fun _ => 1) p -- Simp lemmas for eval @@ -94,42 +94,43 @@ oracle-determined path. Defined as `liftM` into the accumulator monad `TimeM`. - -- Simp lemmas for cost -@[simp] theorem cost_pure (oracle : {ι : Type} → F ι → ι) - (weight : {ι : Type} → F ι → Nat) (a : α) : +@[simp] theorem cost_pure {T : Type} [AddMonoid T] (oracle : {ι : Type} → F ι → ι) + (weight : {ι : Type} → F ι → T) (a : α) : cost oracle weight (.pure a : FreeM F α) = 0 := rfl -@[simp] theorem cost_liftBind (oracle : {ι : Type} → F ι → ι) - (weight : {ι : Type} → F ι → Nat) {ι : Type} (op : F ι) (cont : ι → FreeM F α) : +@[simp] theorem cost_liftBind {T : Type} [AddMonoid T] + (oracle : {ι : Type} → F ι → ι) (weight : {ι : Type} → F ι → T) + {ι : Type} (op : F ι) (cont : ι → FreeM F α) : cost oracle weight (.liftBind op cont) = weight op + cost oracle weight (cont (oracle op)) := rfl -@[simp] theorem cost_bind (oracle : {ι : Type} → F ι → ι) - (weight : {ι : Type} → F ι → Nat) (t : FreeM F α) (f : α → FreeM F β) : +@[simp] theorem cost_bind {T : Type} [AddMonoid T] (oracle : {ι : Type} → F ι → ι) + (weight : {ι : Type} → F ι → T) (t : FreeM F α) (f : α → FreeM F β) : cost oracle weight (t.bind f) = cost oracle weight t + cost oracle weight (f (eval oracle t)) := by induction t with | pure a => simp [FreeM.bind] | liftBind op cont ih => simp only [FreeM.bind, cost_liftBind, eval_liftBind, ih (oracle op)] - omega + simp only [add_assoc] --- Simp lemmas for queriesOn +-- Simp lemmas for countQueries -@[simp] theorem queriesOn_pure (oracle : {ι : Type} → F ι → ι) (a : α) : - queriesOn oracle (.pure a : FreeM F α) = 0 := rfl +@[simp] theorem countQueries_pure (oracle : {ι : Type} → F ι → ι) (a : α) : + countQueries oracle (.pure a : FreeM F α) = 0 := rfl -@[simp] theorem queriesOn_liftBind (oracle : {ι : Type} → F ι → ι) +@[simp] theorem countQueries_liftBind (oracle : {ι : Type} → F ι → ι) {ι : Type} (op : F ι) (cont : ι → FreeM F α) : - queriesOn oracle (.liftBind op cont) = 1 + queriesOn oracle (cont (oracle op)) := rfl + countQueries oracle (.liftBind op cont) = 1 + countQueries oracle (cont (oracle op)) := rfl -@[simp] theorem queriesOn_bind (oracle : {ι : Type} → F ι → ι) +@[simp] theorem countQueries_bind (oracle : {ι : Type} → F ι → ι) (t : FreeM F α) (f : α → FreeM F β) : - queriesOn oracle (t.bind f) = - queriesOn oracle t + queriesOn oracle (f (eval oracle t)) := + countQueries oracle (t.bind f) = + countQueries oracle t + countQueries oracle (f (eval oracle t)) := cost_bind oracle (fun _ => 1) t f -theorem queriesOn_eq_cost_one (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : - queriesOn oracle p = cost oracle (fun _ => 1) p := rfl +theorem countQueries_eq_cost_one (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : + countQueries oracle p = cost oracle (fun _ => 1) p := rfl -- ## Combinatorial lower bound @@ -137,13 +138,13 @@ section LowerBound /-- Finset-based version: if the oracles indexed by `S` produce `|S|`-many distinct evaluation results, then some oracle in `S` makes at least `⌈log_r |S|⌉` queries. -/ -private theorem exists_mem_queriesOn_ge_clog (r : Nat) +private theorem exists_mem_countQueries_ge_clog (r : Nat) (h_fin : ∀ {ρ : Type}, F ρ → Fintype ρ) (h_card : ∀ {ρ : Type} (op : F ρ), @Fintype.card ρ (h_fin op) ≤ r) {ix : Type} (p : FreeM F α) (S : Finset ix) (hS : S.Nonempty) (oracles : ix → ({ρ : Type} → F ρ → ρ)) (h_inj : Set.InjOn (fun i => p.eval (oracles i)) ↑S) : - ∃ i ∈ S, p.queriesOn (oracles i) ≥ Nat.clog r S.card := by + ∃ i ∈ S, p.countQueries (oracles i) ≥ Nat.clog r S.card := by classical induction p generalizing ix S with | pure a => @@ -151,7 +152,7 @@ private theorem exists_mem_queriesOn_ge_clog (r : Nat) refine ⟨i, hi, ?_⟩ have hS1 : S.card ≤ 1 := Finset.card_le_one.mpr fun _ ha _ hb => h_inj ha hb rfl - simp [queriesOn, Nat.clog_of_right_le_one hS1] + simp [countQueries, Nat.clog_of_right_le_one hS1] | @liftBind ρ op cont ih => by_cases hle : S.card ≤ 1 · obtain ⟨i, hi⟩ := hS @@ -191,8 +192,8 @@ private theorem exists_mem_queriesOn_ge_clog (r : Nat) obtain ⟨i, hi, hiq⟩ := ih b S' hS' oracles h_inj' have him := Finset.mem_filter.mp hi refine ⟨i, him.1, ?_⟩ - simp only [queriesOn_liftBind, him.2] - -- Need: Nat.clog r S.card ≤ 1 + (cont b).queriesOn (oracles i) + simp only [countQueries_liftBind, him.2] + -- Need: Nat.clog r S.card ≤ 1 + (cont b).countQueries (oracles i) have hS'_lb : (S.card + r - 1) / r ≤ S'.card := by have h1 : (S.card - 1) / r ≤ (S.card - 1) / Fintype.card ρ := Nat.div_le_div_left hk (by omega) @@ -205,7 +206,7 @@ private theorem exists_mem_queriesOn_ge_clog (r : Nat) rw [Nat.clog_of_two_le hr (by omega)]; omega _ ≤ 1 + Nat.clog r S'.card := Nat.add_le_add_left (Nat.clog_mono_right r hS'_lb) 1 - _ ≤ 1 + (cont b).queriesOn (oracles i) := Nat.add_le_add_left hiq 1 + _ ≤ 1 + (cont b).countQueries (oracles i) := Nat.add_le_add_left hiq 1 /-- If `n` oracles produce `n` distinct evaluation results from a `FreeM F α` program whose every response type is finite of cardinality at most `r`, then some oracle makes @@ -215,15 +216,15 @@ This is the core combinatorial lemma for query complexity lower bounds. The proo the adversarial/partition argument: at each query node, the `n` oracles split by their answer; the largest group (size ≥ ⌈n/r⌉) still produces distinct results in the corresponding subtree, and the induction proceeds there. -/ -theorem exists_queriesOn_ge_clog (r : Nat) +theorem exists_countQueries_ge_clog (r : Nat) (h_fin : ∀ {ρ : Type}, F ρ → Fintype ρ) (h_card : ∀ {ρ : Type} (op : F ρ), @Fintype.card ρ (h_fin op) ≤ r) (p : FreeM F α) {n : Nat} (oracles : Fin n → ({ρ : Type} → F ρ → ρ)) (hn : 0 < n) (h_inj : Function.Injective (fun i => p.eval (oracles i))) : - ∃ i : Fin n, p.queriesOn (oracles i) ≥ Nat.clog r n := by - have ⟨i, _, hi⟩ := exists_mem_queriesOn_ge_clog r h_fin h_card p Finset.univ + ∃ i : Fin n, p.countQueries (oracles i) ≥ Nat.clog r n := by + have ⟨i, _, hi⟩ := exists_mem_countQueries_ge_clog r h_fin h_card p Finset.univ (Finset.univ_nonempty_iff.mpr ⟨⟨0, hn⟩⟩) oracles h_inj.injOn rw [Finset.card_univ, Fintype.card_fin] at hi exact ⟨i, hi⟩ diff --git a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean index da387e492..7f5ab3618 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean @@ -20,18 +20,18 @@ namespace Cslib.Query /-- Insert `x` into a sorted list using comparison queries. -/ @[expose] def orderedInsert (x : α) : List α → FreeM (LEQuery α) (List α) - | [] => pure [x] + | [] => return [x] | y :: ys => do let le ← LEQuery.ask x y if le then - pure (x :: y :: ys) + return (x :: y :: ys) else do let rest ← orderedInsert x ys - pure (y :: rest) + return (y :: rest) /-- Sort a list using insertion sort with comparison queries. -/ @[expose] def insertionSort : List α → FreeM (LEQuery α) (List α) - | [] => pure [] + | [] => return [] | x :: xs => do let sorted ← insertionSort xs orderedInsert x sorted diff --git a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean index 96d862211..fbe9aaaae 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean @@ -15,7 +15,7 @@ public import Mathlib.Algebra.Group.Defs /-! # Insertion Sort: Correctness and Upper Bound Proofs that `insertionSort` is a correct comparison sort and uses at most `n²` queries. -All proofs are by plain equational reasoning on `FreeM.eval` and `FreeM.queriesOn`. +All proofs are by plain equational reasoning on `FreeM.eval` and `FreeM.countQueries`. -/ open Cslib Cslib.Query @@ -26,51 +26,40 @@ namespace Cslib.Query variable {α : Type} --- ## Evaluation simp lemmas for orderedInsert +-- ## Evaluation -@[simp] theorem eval_orderedInsert_nil (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) : - (orderedInsert x ([] : List α)).eval oracle = [x] := by - simp [orderedInsert] - -@[simp] theorem eval_orderedInsert_cons (oracle : {ι : Type} → LEQuery α ι → ι) (x y : α) - (ys : List α) : - (orderedInsert x (y :: ys)).eval oracle = - if oracle (.le x y) then x :: y :: ys - else y :: (orderedInsert x ys).eval oracle := by - simp [orderedInsert, LEQuery.ask] - split <;> simp_all - --- ## Evaluation simp lemmas for insertionSort - -@[simp] theorem eval_insertionSort_nil (oracle : {ι : Type} → LEQuery α ι → ι) : - (insertionSort (α := α) []).eval oracle = [] := by - simp [insertionSort] - -@[simp] theorem eval_insertionSort_cons (oracle : {ι : Type} → LEQuery α ι → ι) +/-- Evaluating query-based insertion agrees with `List.orderedInsert` using the relation +supplied by the oracle. -/ +@[simp] theorem eval_orderedInsert (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) (xs : List α) : - (insertionSort (x :: xs)).eval oracle = - (orderedInsert x ((insertionSort xs).eval oracle)).eval oracle := by - simp [insertionSort] + (orderedInsert x xs).eval oracle = + xs.orderedInsert (fun x y => oracle (.le x y)) x := by + induction xs with + | nil => simp [orderedInsert] + | cons y ys ih => + simp [orderedInsert] + split <;> simp_all + +/-- Evaluating query-based insertion sort agrees with `List.insertionSort` using the relation +supplied by the oracle. -/ +@[simp] theorem eval_insertionSort (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : + (insertionSort xs).eval oracle = + xs.insertionSort (fun x y => oracle (.le x y)) := by + induction xs with + | nil => simp [insertionSort] + | cons x xs ih => simp [insertionSort, ih] -- ## Permutation proofs theorem orderedInsert_perm (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) (xs : List α) : ((orderedInsert x xs).eval oracle).Perm (x :: xs) := by - induction xs with - | nil => simp - | cons y ys ih => - simp only [eval_orderedInsert_cons] - split - · exact List.Perm.refl _ - · exact (List.Perm.cons _ ih).trans (List.Perm.swap _ _ _) + rw [eval_orderedInsert] + exact List.perm_orderedInsert _ _ _ theorem insertionSort_perm (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : ((insertionSort xs).eval oracle).Perm xs := by - induction xs with - | nil => simp - | cons x xs ih => - simp only [eval_insertionSort_cons] - exact (orderedInsert_perm oracle x _).trans (List.Perm.cons _ ih) + rw [eval_insertionSort] + exact List.perm_insertionSort _ _ -- ## Sortedness proofs @@ -80,26 +69,8 @@ theorem orderedInsert_sorted (horacle : ∀ a b, oracle (.le a b) = decide (r a b)) (x : α) (xs : List α) (hxs : xs.Pairwise r) : ((orderedInsert x xs).eval oracle).Pairwise r := by - induction xs with - | nil => simp - | cons y ys ih => - simp only [eval_orderedInsert_cons, horacle] - split - next h => - have hle : r x y := by simpa [decide_eq_true_eq] using h - exact List.pairwise_cons.mpr ⟨fun z hz => - match List.mem_cons.mp hz with - | .inl h => h ▸ hle - | .inr h => _root_.trans hle (List.rel_of_pairwise_cons hxs h), hxs⟩ - next h => - have hle : ¬ r x y := by simpa [decide_eq_true_eq] using h - have hyx : r y x := (Std.Total.total y x).resolve_right hle - have ih' := ih hxs.of_cons - have hperm := orderedInsert_perm oracle x ys - exact List.pairwise_cons.mpr ⟨fun z hz => - match List.mem_cons.mp (hperm.mem_iff.mp hz) with - | .inl h => h ▸ hyx - | .inr h => List.rel_of_pairwise_cons hxs h, ih'⟩ + rw [eval_orderedInsert] + simpa only [horacle, decide_eq_true_eq] using hxs.orderedInsert x xs theorem insertionSort_sorted (r : α → α → Prop) [DecidableRel r] [Std.Total r] [IsTrans α r] @@ -107,40 +78,37 @@ theorem insertionSort_sorted (horacle : ∀ a b, oracle (.le a b) = decide (r a b)) (xs : List α) : ((insertionSort xs).eval oracle).Pairwise r := by - induction xs with - | nil => simp - | cons x xs ih => - simp only [eval_insertionSort_cons] - exact orderedInsert_sorted r oracle horacle x _ ih + rw [eval_insertionSort] + simpa only [horacle, decide_eq_true_eq] using List.pairwise_insertionSort r xs -- ## Query count proofs -theorem orderedInsert_queriesOn_le (oracle : {ι : Type} → LEQuery α ι → ι) +theorem orderedInsert_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) (xs : List α) : - (orderedInsert x xs).queriesOn oracle ≤ xs.length := by + (orderedInsert x xs).countQueries oracle ≤ xs.length := by induction xs with | nil => simp [orderedInsert] | cons y ys ih => - unfold orderedInsert LEQuery.ask + unfold orderedInsert simp split · simp_all · simp_all; omega -theorem insertionSort_queriesOn_le (oracle : {ι : Type} → LEQuery α ι → ι) +theorem insertionSort_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : - (insertionSort xs).queriesOn oracle ≤ xs.length ^ 2 := by + (insertionSort xs).countQueries oracle ≤ xs.length ^ 2 := by induction xs with | nil => simp [insertionSort] | cons x xs ih => - have hq : (insertionSort (x :: xs)).queriesOn oracle = - (insertionSort xs).queriesOn oracle + - (orderedInsert x ((insertionSort xs).eval oracle)).queriesOn oracle := by + have hq : (insertionSort (x :: xs)).countQueries oracle = + (insertionSort xs).countQueries oracle + + (orderedInsert x ((insertionSort xs).eval oracle)).countQueries oracle := by simp [insertionSort] rw [hq] have hlen : ((insertionSort xs).eval oracle).length = xs.length := (insertionSort_perm oracle xs).length_eq - have hord := orderedInsert_queriesOn_le oracle x ((insertionSort xs).eval oracle) + have hord := orderedInsert_countQueries_le oracle x ((insertionSort xs).eval oracle) rw [hlen] at hord have h1 := Nat.add_le_add ih hord have hpow : xs.length ^ 2 + xs.length ≤ (xs.length + 1) ^ 2 := by @@ -154,7 +122,7 @@ theorem insertionSort_queriesOn_le (oracle : {ι : Type} → LEQuery α ι → public theorem insertionSort_upperBound : UpperBound (insertionSort (α := α)) List.length (· ^ 2) := by intro oracle n x hle - exact Nat.le_trans (insertionSort_queriesOn_le oracle x) + exact Nat.le_trans (insertionSort_countQueries_le oracle x) (Nat.pow_le_pow_left hle 2) public theorem insertionSort_isSort : IsSort (insertionSort (α := α)) where diff --git a/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean b/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean index d5e4f1970..10f3df0ec 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean @@ -22,7 +22,7 @@ inductive LEQuery (α : Type) : Type → Type where | le (a b : α) : LEQuery α Bool /-- Lift `LEQuery.le a b` into a `FreeM` that returns the comparison result. -/ -@[expose] def LEQuery.ask (a b : α) : FreeM (LEQuery α) Bool := +abbrev LEQuery.ask (a b : α) : FreeM (LEQuery α) Bool := FreeM.lift (.le a b) @[simp] theorem LEQuery.eval_ask (oracle : {ι : Type} → LEQuery α ι → ι) (a b : α) : diff --git a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean index 12811245d..601efe13f 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean @@ -20,7 +20,7 @@ has query complexity at least `⌈log₂(n!)⌉` for every input size `n`. The proof constructs `n!` distinct total orders on `α` (one per permutation of `n` embedded elements), shows they produce distinct sorted outputs, and applies -`FreeM.exists_queriesOn_ge_clog` with `LEQuery.fintypeResponse` / +`FreeM.exists_countQueries_ge_clog` with `LEQuery.fintypeResponse` / `LEQuery.cardResponse_le_two` witnessing that all responses come from `Bool` (cardinality 2). -/ @@ -154,7 +154,7 @@ theorem IsSort.lowerBound_infinite [Infinite α] exact h_perm.trans (map_perm_of_infinite_embedding (e.symm i)).symm |>.eq_of_pairwise' h_sorted (pairwise_map_infinitePermOrder (e.symm i)) -- Apply the FreeM lower-bound lemma directly - obtain ⟨i, hi⟩ := FreeM.exists_queriesOn_ge_clog 2 + obtain ⟨i, hi⟩ := FreeM.exists_countQueries_ge_clog 2 LEQuery.fintypeResponse LEQuery.cardResponse_le_two (sort xs) progOracles (Nat.factorial_pos n) h_inj exact ⟨progOracles i, hi⟩ diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean index 9b72d39a7..63d498568 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean @@ -10,8 +10,11 @@ public import Cslib.Algorithms.Lean.Query.Sort.LEQuery /-! # Merge Sort as a Query Program Merge sort implemented as a `FreeM (LEQuery α)`, making all comparison queries explicit. -Uses an alternating split (odds/evens) to avoid needing `List.length` in the termination -argument. +The alternating split (odds/evens) is structurally recursive: each recursive call consumes +two constructors and operates directly on the remaining tail, so `split` needs no +well-founded recursion argument based on `List.length`. The recursive calls of `mergeSort` +itself are not structural, since the two halves are not syntactic subterms, and are justified +separately using their lengths. -/ open Cslib Cslib.Query @@ -63,23 +66,23 @@ theorem split_snd_length_lt (x y : α) (zs : List α) : /-- Merge two sorted lists using comparison queries. -/ @[expose] def merge (xs ys : List α) : FreeM (LEQuery α) (List α) := match xs, ys with - | [], ys => pure ys - | xs, [] => pure xs + | [], ys => return ys + | xs, [] => return xs | x :: xs', y :: ys' => do let le ← LEQuery.ask x y if le then do let rest ← merge xs' (y :: ys') - pure (x :: rest) + return (x :: rest) else do let rest ← merge (x :: xs') ys' - pure (y :: rest) + return (y :: rest) termination_by xs.length + ys.length /-- Sort a list using merge sort with comparison queries. -/ @[expose] def mergeSort (xs : List α) : FreeM (LEQuery α) (List α) := match xs with - | [] => pure [] - | [x] => pure [x] + | [] => return [] + | [x] => return [x] | x :: y :: zs => do let sl ← mergeSort (split (x :: y :: zs)).1 let sr ← mergeSort (split (x :: y :: zs)).2 diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean index ab61d6758..f2603ffb8 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean @@ -15,7 +15,7 @@ public import Mathlib.Data.Nat.Log /-! # Merge Sort: Correctness and Upper Bound Proofs that `mergeSort` is a correct comparison sort and uses at most `n * ⌈log₂ n⌉` queries. -All proofs are by plain equational reasoning on `FreeM.eval` and `FreeM.queriesOn`. +All proofs are by plain equational reasoning on `FreeM.eval` and `FreeM.countQueries`. -/ open Cslib Cslib.Query @@ -60,7 +60,7 @@ theorem split_lengths_add (xs : List α) : if oracle (.le x y) then x :: (merge xs' (y :: ys')).eval oracle else y :: (merge (x :: xs') ys').eval oracle := by - simp [merge, LEQuery.ask] + simp [merge] split <;> simp_all -- ## Evaluation simp lemmas for mergeSort @@ -167,50 +167,50 @@ theorem mergeSort_sorted -- ## Query count simp lemmas -@[simp] theorem queriesOn_merge_nil_left (oracle : {ι : Type} → LEQuery α ι → ι) (ys : List α) : - (merge ([] : List α) ys).queriesOn oracle = 0 := by +@[simp] theorem countQueries_merge_nil_left (oracle : {ι : Type} → LEQuery α ι → ι) (ys : List α) : + (merge ([] : List α) ys).countQueries oracle = 0 := by simp [merge] -@[simp] theorem queriesOn_merge_nil_right (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : - (merge xs ([] : List α)).queriesOn oracle = 0 := by +@[simp] theorem countQueries_merge_nil_right (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : + (merge xs ([] : List α)).countQueries oracle = 0 := by cases xs <;> simp [merge] -@[simp] theorem queriesOn_merge_cons_cons (oracle : {ι : Type} → LEQuery α ι → ι) +@[simp] theorem countQueries_merge_cons_cons (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) (xs' : List α) (y : α) (ys' : List α) : - (merge (x :: xs') (y :: ys')).queriesOn oracle = + (merge (x :: xs') (y :: ys')).countQueries oracle = 1 + if oracle (.le x y) - then (merge xs' (y :: ys')).queriesOn oracle - else (merge (x :: xs') ys').queriesOn oracle := by - simp [merge, LEQuery.ask] + then (merge xs' (y :: ys')).countQueries oracle + else (merge (x :: xs') ys').countQueries oracle := by + simp [merge] split <;> simp_all -@[simp] theorem queriesOn_mergeSort_nil (oracle : {ι : Type} → LEQuery α ι → ι) : - (mergeSort (α := α) []).queriesOn oracle = 0 := by +@[simp] theorem countQueries_mergeSort_nil (oracle : {ι : Type} → LEQuery α ι → ι) : + (mergeSort (α := α) []).countQueries oracle = 0 := by simp [mergeSort] -@[simp] theorem queriesOn_mergeSort_singleton (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) : - (mergeSort [x]).queriesOn oracle = 0 := by +@[simp] theorem countQueries_mergeSort_singleton (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) : + (mergeSort [x]).countQueries oracle = 0 := by simp [mergeSort] -@[simp] theorem queriesOn_mergeSort_cons_cons (oracle : {ι : Type} → LEQuery α ι → ι) +@[simp] theorem countQueries_mergeSort_cons_cons (oracle : {ι : Type} → LEQuery α ι → ι) (x y : α) (zs : List α) : - (mergeSort (x :: y :: zs)).queriesOn oracle = - (mergeSort (split (x :: y :: zs)).1).queriesOn oracle + - ((mergeSort (split (x :: y :: zs)).2).queriesOn oracle + + (mergeSort (x :: y :: zs)).countQueries oracle = + (mergeSort (split (x :: y :: zs)).1).countQueries oracle + + ((mergeSort (split (x :: y :: zs)).2).countQueries oracle + (merge ((mergeSort (split (x :: y :: zs)).1).eval oracle) - ((mergeSort (split (x :: y :: zs)).2).eval oracle)).queriesOn oracle) := by + ((mergeSort (split (x :: y :: zs)).2).eval oracle)).countQueries oracle) := by simp [mergeSort] -- ## Query count proofs -theorem merge_queriesOn_le (oracle : {ι : Type} → LEQuery α ι → ι) +theorem merge_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι) (xs ys : List α) : - (merge xs ys).queriesOn oracle ≤ xs.length + ys.length := by + (merge xs ys).countQueries oracle ≤ xs.length + ys.length := by induction xs, ys using merge.induct (α := α) with | case1 ys => simp | case2 xs => simp | case3 x xs' y ys' ih_true ih_false => - simp only [queriesOn_merge_cons_cons, List.length_cons] + simp only [countQueries_merge_cons_cons, List.length_cons] split <;> simp_all <;> omega /-- The key arithmetic inequality for the merge sort recurrence: @@ -233,15 +233,15 @@ private theorem mergeSort_bound (n : ℕ) (hn : 2 ≤ n) : _ = ((n + 1) / 2 + n / 2) * Nat.clog 2 n := (Nat.add_mul ..).symm _ = n * Nat.clog 2 n := by rw [hsum] -theorem mergeSort_queriesOn_le (oracle : {ι : Type} → LEQuery α ι → ι) +theorem mergeSort_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : - (mergeSort xs).queriesOn oracle ≤ xs.length * Nat.clog 2 xs.length := by + (mergeSort xs).countQueries oracle ≤ xs.length * Nat.clog 2 xs.length := by induction xs using mergeSort.induct (α := α) with | case1 => simp [mergeSort] | case2 x => simp [mergeSort] | case3 x y zs ih_l ih_r => - simp only [queriesOn_mergeSort_cons_cons] - have hml := merge_queriesOn_le oracle + simp only [countQueries_mergeSort_cons_cons] + have hml := merge_countQueries_le oracle ((mergeSort (split (x :: y :: zs)).1).eval oracle) ((mergeSort (split (x :: y :: zs)).2).eval oracle) rw [(mergeSort_perm oracle (split (x :: y :: zs)).1).length_eq, @@ -257,7 +257,7 @@ theorem mergeSort_queriesOn_le (oracle : {ι : Type} → LEQuery α ι → ι) public theorem mergeSort_upperBound : UpperBound (mergeSort (α := α)) List.length (fun n => n * Nat.clog 2 n) := by intro oracle n x hle - exact Nat.le_trans (mergeSort_queriesOn_le oracle x) + exact Nat.le_trans (mergeSort_countQueries_le oracle x) (Nat.mul_le_mul hle (Nat.clog_mono_right 2 hle)) public theorem mergeSort_isSort : IsSort (mergeSort (α := α)) where From 40ea780883d0dd054e7c960957d87492501d8d88 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Thu, 27 Aug 2026 16:07:35 +1000 Subject: [PATCH 53/75] fix(Query): adapt to Lean 4.34 --- Cslib/Algorithms/Lean/Query/FreeM.lean | 76 ++++++++++++++----- .../Lean/Query/Sort/Insertion/Lemmas.lean | 7 +- .../Lean/Query/Sort/LowerBound.lean | 10 +-- 3 files changed, 67 insertions(+), 26 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean index 90c26567a..b50fe0a18 100644 --- a/Cslib/Algorithms/Lean/Query/FreeM.lean +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -79,56 +79,95 @@ accumulated along the oracle-determined path. Defined as `liftM` into `TimeM`. - -- Simp lemmas for eval @[simp] theorem eval_pure (oracle : {ι : Type} → F ι → ι) (a : α) : - eval oracle (.pure a : FreeM F α) = a := rfl + eval oracle (pure a : FreeM F α) = a := rfl @[simp] theorem eval_liftBind (oracle : {ι : Type} → F ι → ι) {ι : Type} (op : F ι) (cont : ι → FreeM F α) : - eval oracle (.liftBind op cont) = eval oracle (cont (oracle op)) := rfl + eval oracle (FreeM.lift op >>= cont) = eval oracle (cont (oracle op)) := rfl + +@[simp] theorem eval_lift (oracle : {ι : Type} → F ι → ι) {ι : Type} (op : F ι) : + eval oracle (FreeM.lift op) = oracle op := rfl @[simp] theorem eval_bind (oracle : {ι : Type} → F ι → ι) (t : FreeM F α) (f : α → FreeM F β) : - eval oracle (t.bind f) = eval oracle (f (eval oracle t)) := by + eval oracle (t >>= f) = eval oracle (f (eval oracle t)) := by induction t with | pure a => rfl - | liftBind op cont ih => exact ih (oracle op) + | lift_bind op cont ih => exact ih (oracle op) + +@[simp] theorem eval_map (oracle : {ι : Type} → F ι → ι) + (t : FreeM F α) (f : α → β) : + eval oracle (f <$> t) = f (eval oracle t) := by + rw [← FreeM.map_eq_map, ← FreeM.bind_pure_comp, FreeM.bind_eq_bind, eval_bind] + simp -- Simp lemmas for cost @[simp] theorem cost_pure {T : Type} [AddMonoid T] (oracle : {ι : Type} → F ι → ι) (weight : {ι : Type} → F ι → T) (a : α) : - cost oracle weight (.pure a : FreeM F α) = 0 := rfl + cost oracle weight (pure a : FreeM F α) = 0 := rfl @[simp] theorem cost_liftBind {T : Type} [AddMonoid T] (oracle : {ι : Type} → F ι → ι) (weight : {ι : Type} → F ι → T) {ι : Type} (op : F ι) (cont : ι → FreeM F α) : - cost oracle weight (.liftBind op cont) = + cost oracle weight (FreeM.lift op >>= cont) = weight op + cost oracle weight (cont (oracle op)) := rfl +@[simp] theorem cost_lift {T : Type} [AddMonoid T] + (oracle : {ι : Type} → F ι → ι) (weight : {ι : Type} → F ι → T) + {ι : Type} (op : F ι) : + cost oracle weight (FreeM.lift op) = weight op := by + change weight op + 0 = weight op + exact add_zero _ + @[simp] theorem cost_bind {T : Type} [AddMonoid T] (oracle : {ι : Type} → F ι → ι) (weight : {ι : Type} → F ι → T) (t : FreeM F α) (f : α → FreeM F β) : - cost oracle weight (t.bind f) = + cost oracle weight (t >>= f) = cost oracle weight t + cost oracle weight (f (eval oracle t)) := by induction t with - | pure a => simp [FreeM.bind] - | liftBind op cont ih => - simp only [FreeM.bind, cost_liftBind, eval_liftBind, ih (oracle op)] - simp only [add_assoc] + | pure a => + change cost oracle weight (f a) = 0 + cost oracle weight (f a) + simp + | lift_bind op cont ih => + change weight op + cost oracle weight (cont (oracle op) >>= f) = + (weight op + cost oracle weight (cont (oracle op))) + + cost oracle weight (f (eval oracle (cont (oracle op)))) + simp only [ih, add_assoc] + +@[simp] theorem cost_map {T : Type} [AddMonoid T] + (oracle : {ι : Type} → F ι → ι) (weight : {ι : Type} → F ι → T) + (t : FreeM F α) (f : α → β) : + cost oracle weight (f <$> t) = cost oracle weight t := by + rw [← FreeM.map_eq_map, ← FreeM.bind_pure_comp, FreeM.bind_eq_bind, cost_bind] + simp -- Simp lemmas for countQueries @[simp] theorem countQueries_pure (oracle : {ι : Type} → F ι → ι) (a : α) : - countQueries oracle (.pure a : FreeM F α) = 0 := rfl + countQueries oracle (pure a : FreeM F α) = 0 := rfl @[simp] theorem countQueries_liftBind (oracle : {ι : Type} → F ι → ι) {ι : Type} (op : F ι) (cont : ι → FreeM F α) : - countQueries oracle (.liftBind op cont) = 1 + countQueries oracle (cont (oracle op)) := rfl + countQueries oracle (FreeM.lift op >>= cont) = + 1 + countQueries oracle (cont (oracle op)) := rfl + +@[simp] theorem countQueries_lift (oracle : {ι : Type} → F ι → ι) + {ι : Type} (op : F ι) : + countQueries oracle (FreeM.lift op) = 1 := by + change 1 + 0 = 1 + rfl @[simp] theorem countQueries_bind (oracle : {ι : Type} → F ι → ι) (t : FreeM F α) (f : α → FreeM F β) : - countQueries oracle (t.bind f) = + countQueries oracle (t >>= f) = countQueries oracle t + countQueries oracle (f (eval oracle t)) := cost_bind oracle (fun _ => 1) t f +@[simp] theorem countQueries_map (oracle : {ι : Type} → F ι → ι) + (t : FreeM F α) (f : α → β) : + countQueries oracle (f <$> t) = countQueries oracle t := + cost_map oracle (fun _ => 1) t f + theorem countQueries_eq_cost_one (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : countQueries oracle p = cost oracle (fun _ => 1) p := rfl @@ -153,7 +192,7 @@ private theorem exists_mem_countQueries_ge_clog (r : Nat) have hS1 : S.card ≤ 1 := Finset.card_le_one.mpr fun _ ha _ hb => h_inj ha hb rfl simp [countQueries, Nat.clog_of_right_le_one hS1] - | @liftBind ρ op cont ih => + | @lift_bind ρ op cont ih => by_cases hle : S.card ≤ 1 · obtain ⟨i, hi⟩ := hS exact ⟨i, hi, by simp [Nat.clog_of_right_le_one hle]⟩ @@ -163,7 +202,7 @@ private theorem exists_mem_countQueries_ge_clog (r : Nat) exact ⟨i, hi, by simp [Nat.clog_of_left_le_one hr]⟩ push Not at hr -- 2 ≤ r, 2 ≤ S.card - letI : Fintype ρ := h_fin op + let _ : Fintype ρ := h_fin op have hk : Fintype.card ρ ≤ r := h_card op -- Fintype.card ρ ≥ 1: any oracle produces an answer obtain ⟨i₀, _hi₀⟩ := hS @@ -188,11 +227,12 @@ private theorem exists_mem_countQueries_ge_clog (r : Nat) have him := Finset.mem_coe.mp hi |> Finset.mem_filter.mp have hjm := Finset.mem_coe.mp hj |> Finset.mem_filter.mp exact h_inj (Finset.mem_coe.mpr him.1) (Finset.mem_coe.mpr hjm.1) - (by simp [him.2, hjm.2, heq]) + (by simpa [FreeM.liftBind_eq, him.2, hjm.2] using heq) obtain ⟨i, hi, hiq⟩ := ih b S' hS' oracles h_inj' have him := Finset.mem_filter.mp hi refine ⟨i, him.1, ?_⟩ - simp only [countQueries_liftBind, him.2] + change countQueries (oracles i) (FreeM.lift op >>= cont) ≥ Nat.clog r S.card + rw [countQueries_liftBind, him.2] -- Need: Nat.clog r S.card ≤ 1 + (cont b).countQueries (oracles i) have hS'_lb : (S.card + r - 1) / r ≤ S'.card := by have h1 : (S.card - 1) / r ≤ (S.card - 1) / Fintype.card ρ := diff --git a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean index fbe9aaaae..3e4f26ea2 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean @@ -91,9 +91,10 @@ theorem orderedInsert_countQueries_le (oracle : {ι : Type} → LEQuery α ι | cons y ys ih => unfold orderedInsert simp - split - · simp_all - · simp_all; omega + by_cases h : oracle (.le x y) = true + · simp [h] + · simp [h] + omega theorem insertionSort_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : diff --git a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean index 601efe13f..b9536de65 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean @@ -58,7 +58,7 @@ private theorem infinitePermOrder.choose_eq [Infinite α] {i : Fin n} private instance [Infinite α] : IsTrans α (infinitePermOrder (α := α) n σ) where trans a b c hab hbc := by - letI : LinearOrder α := IsWellOrder.linearOrder WellOrderingRel + let _ : LinearOrder α := IsWellOrder.linearOrder WellOrderingRel unfold infinitePermOrder at * by_cases ha : ∃ i : Fin n, (Infinite.natEmbedding α) i.val = a <;> by_cases hb : ∃ j : Fin n, (Infinite.natEmbedding α) j.val = b <;> @@ -68,19 +68,19 @@ private instance [Infinite α] : private instance [Infinite α] : Std.Total (infinitePermOrder (α := α) n σ) where total a b := by - letI : LinearOrder α := IsWellOrder.linearOrder WellOrderingRel + let _ : LinearOrder α := IsWellOrder.linearOrder WellOrderingRel unfold infinitePermOrder by_cases ha : ∃ i : Fin n, (Infinite.natEmbedding α) i.val = a - · simp only [dite_else_true] + · simp only [dite_true_right] grind - · simp_all only [reduceDIte, dite_eq_ite, if_true_left] + · simp_all only [reduceDIte, dite_eq_ite, ite_true_left] grind attribute [local grind inj] Equiv.injective in private instance [Infinite α] : Std.Antisymm (infinitePermOrder (α := α) n σ) where antisymm a b hab hba := by - letI : LinearOrder α := IsWellOrder.linearOrder WellOrderingRel + let _ : LinearOrder α := IsWellOrder.linearOrder WellOrderingRel simp only [infinitePermOrder] at hab hba by_cases ha : ∃ i : Fin n, (Infinite.natEmbedding α) i.val = a <;> by_cases hb : ∃ j : Fin n, (Infinite.natEmbedding α) j.val = b <;> From 79c29f81eabddf9f353a8e95f45a96a2d7197459 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Thu, 27 Aug 2026 16:14:25 +1000 Subject: [PATCH 54/75] docs(Query): update FreeM simp description --- Cslib/Algorithms/Lean/Query/FreeM.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean index b50fe0a18..d4d2d7791 100644 --- a/Cslib/Algorithms/Lean/Query/FreeM.lean +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -56,7 +56,7 @@ than direct pattern-match on `FreeM`'s constructors: an arbitrary additive monoid). - `countQueries` is `cost` with unit weight. -The constructor-form simp lemmas (`eval_pure`, `eval_liftBind`, `cost_pure`, +The pure and lift-then-bind simp lemmas (`eval_pure`, `eval_liftBind`, `cost_pure`, `cost_liftBind`, `countQueries_pure`, `countQueries_liftBind`) all reduce by `rfl`, giving the same proof ergonomics as direct pattern-match definitions while honouring the universal property as the primary abstraction. -/ From f25748521a74bbfd33ec5edf1fc8a51a4f531484 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Thu, 27 Aug 2026 16:58:39 +1000 Subject: [PATCH 55/75] refactor(Query): polish docs and merge sort --- Cslib/Algorithms/Lean/Query/Arith/Defs.lean | 2 +- Cslib/Algorithms/Lean/Query/Bounds.lean | 2 +- Cslib/Algorithms/Lean/Query/FreeM.lean | 7 ++++--- Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean | 15 +++++++-------- Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean | 5 +++-- .../Algorithms/Lean/Query/Sort/Merge/Lemmas.lean | 7 +++---- 6 files changed, 19 insertions(+), 19 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Arith/Defs.lean b/Cslib/Algorithms/Lean/Query/Arith/Defs.lean index 0da62a578..c80030fdc 100644 --- a/Cslib/Algorithms/Lean/Query/Arith/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Arith/Defs.lean @@ -64,7 +64,7 @@ end ArithQuery /-- Gauss's trick for complex multiplication: computes `(a+b)(c+d)` to save one multiplication, at the cost of extra additions and subtractions. - Uses 3 multiplications, 2 subtractions, 2 additions. -/ + Uses 3 multiplications, 2 subtractions, 3 additions. -/ @[expose] def complexMulGauss (a b c d : α) : FreeM (ArithQuery α) (α × α) := do let ac ← ArithQuery.doMul a c let bd ← ArithQuery.doMul b d diff --git a/Cslib/Algorithms/Lean/Query/Bounds.lean b/Cslib/Algorithms/Lean/Query/Bounds.lean index 964412803..3dda77669 100644 --- a/Cslib/Algorithms/Lean/Query/Bounds.lean +++ b/Cslib/Algorithms/Lean/Query/Bounds.lean @@ -23,7 +23,7 @@ namespace Cslib.Query ∀ (oracle : {ι : Type} → Q ι → ι) (n : Nat) (x : α), size x ≤ n → (prog x).countQueries oracle ≤ bound n -/-- Lower bound: for every size n, there exists an input and oracle +/-- Lower bound: for every size n, there exists an input of size at most n and an oracle making the program perform ≥ `bound n` queries. -/ @[expose] def LowerBound (prog : α → FreeM Q β) (size : α → Nat) (bound : Nat → Nat) : Prop := diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean index d4d2d7791..ec20c2c2f 100644 --- a/Cslib/Algorithms/Lean/Query/FreeM.lean +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -22,9 +22,10 @@ The key operations are: - `FreeM.countQueries oracle p`: count queries along the oracle-determined path - `FreeM.cost oracle weight p`: weighted query cost in any additive monoid -Because the oracle is supplied *after* the program produces its query plan (the `FreeM` tree), -a sound implementation has no way to "guess" what the oracle would respond. This is the -foundation of the anti-cheating guarantee for both upper and lower bounds. +The program `p` must be fixed independently of `oracle`. Arbitrary pure computation embedded +in `p` is uncharged, so `countQueries` and `cost` measure query complexity rather than total +runtime. However, pure code cannot inspect oracle responses: those enter only through +`FreeM.lift`. This provides an alternative to the `TimeM`-based cost analysis in `Cslib.Algorithms.Lean.MergeSort`: here query counting is structural (derived from the diff --git a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean index b9536de65..782e82303 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean @@ -139,20 +139,19 @@ theorem IsSort.lowerBound_infinite [Infinite α] let progOracles : Fin (Nat.factorial n) → ({ι : Type} → LEQuery α ι → ι) := fun i => LEQuery.oracleOf (fun p => decide (infinitePermOrder n (e.symm i) p.1 p.2)) -- Each oracle produces a unique sorted output - have h_inj : Function.Injective (fun i => (sort xs).eval (progOracles i)) := by - intro i j h_eval - suffices key : ∀ i, (sort xs).eval (progOracles i) = - (List.finRange n).map (fun k => ι ((e.symm i) k).val) by - dsimp only at h_eval - rw [key, key] at h_eval - exact e.symm.injective (map_infinite_embedding_injective h_eval) - intro i + have eval_eq_map (i) : (sort xs).eval (progOracles i) = + (List.finRange n).map (fun k => ι ((e.symm i) k).val) := by have h_perm := h.perm xs (progOracles i) have h_sorted := h.sorted xs (progOracles i) (infinitePermOrder (α := α) n (e.symm i)) (fun a b => by simp [progOracles]) exact h_perm.trans (map_perm_of_infinite_embedding (e.symm i)).symm |>.eq_of_pairwise' h_sorted (pairwise_map_infinitePermOrder (e.symm i)) + have h_inj : Function.Injective (fun i => (sort xs).eval (progOracles i)) := by + intro i j h_eval + dsimp only at h_eval + rw [eval_eq_map, eval_eq_map] at h_eval + exact e.symm.injective (map_infinite_embedding_injective h_eval) -- Apply the FreeM lower-bound lemma directly obtain ⟨i, hi⟩ := FreeM.exists_countQueries_ge_clog 2 LEQuery.fintypeResponse LEQuery.cardResponse_le_two diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean index 63d498568..fd2fb6838 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean @@ -84,8 +84,9 @@ termination_by xs.length + ys.length | [] => return [] | [x] => return [x] | x :: y :: zs => do - let sl ← mergeSort (split (x :: y :: zs)).1 - let sr ← mergeSort (split (x :: y :: zs)).2 + let halves := split (x :: y :: zs) + let sl ← mergeSort halves.1 + let sr ← mergeSort halves.2 merge sl sr termination_by xs.length decreasing_by diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean index f2603ffb8..4b3934a63 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean @@ -8,7 +8,6 @@ module public import Cslib.Algorithms.Lean.Query.Bounds public import Cslib.Algorithms.Lean.Query.Sort.IsSort public import Cslib.Algorithms.Lean.Query.Sort.Merge.Defs -import Mathlib.Data.List.Sort public import Mathlib.Algebra.Group.Defs public import Mathlib.Data.Nat.Log @@ -101,7 +100,7 @@ theorem mergeSort_perm (oracle : {ι : Type} → LEQuery α ι → ι) (xs : Lis induction xs using mergeSort.induct (α := α) with | case1 => simp | case2 x => simp - | case3 x y zs ih_l ih_r => + | case3 x y zs halves ih_l ih_r => simp only [eval_mergeSort_cons_cons] exact (merge_perm oracle _ _).trans ((ih_l.append ih_r).trans (split_perm _)) @@ -161,7 +160,7 @@ theorem mergeSort_sorted induction xs using mergeSort.induct (α := α) with | case1 => simp | case2 x => simp - | case3 x y zs ih_l ih_r => + | case3 x y zs halves ih_l ih_r => simp only [eval_mergeSort_cons_cons] exact merge_sorted r oracle horacle _ _ ih_l ih_r @@ -239,7 +238,7 @@ theorem mergeSort_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι induction xs using mergeSort.induct (α := α) with | case1 => simp [mergeSort] | case2 x => simp [mergeSort] - | case3 x y zs ih_l ih_r => + | case3 x y zs halves ih_l ih_r => simp only [countQueries_mergeSort_cons_cons] have hml := merge_countQueries_le oracle ((mergeSort (split (x :: y :: zs)).1).eval oracle) From 1cc3324b436249895e6425cea0c6db8a563581d8 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Thu, 27 Aug 2026 20:40:06 +1000 Subject: [PATCH 56/75] refactor(Query): apply second-opinion review --- Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean | 19 ++++++++++++++----- Cslib/Algorithms/Lean/Query/FreeM.lean | 4 ++-- .../Lean/Query/Sort/Insertion/Lemmas.lean | 2 +- Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean | 10 +++++----- .../Lean/Query/Sort/LowerBound.lean | 2 +- .../Lean/Query/Sort/Merge/Lemmas.lean | 4 ---- 6 files changed, 23 insertions(+), 18 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean index 2df489d9b..72de6422f 100644 --- a/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean @@ -30,7 +30,7 @@ variable {α : Type} -- ## Correctness -theorem complexMulNaive_eval_honest [Ring α] (a b c d : α) : +theorem complexMulNaive_eval_honest [Add α] [Sub α] [Mul α] (a b c d : α) : (complexMulNaive a b c d).eval ArithQuery.honest = (a * c - b * d, a * d + b * c) := by simp [complexMulNaive, ArithQuery.doMul, ArithQuery.doSub, ArithQuery.doAdd, ArithQuery.honest] @@ -57,11 +57,20 @@ theorem complexMulGauss_cost (oracle : {ι : Type} → ArithQuery α ι → ι) -- ## Crossover: Gauss beats naive when multiplication costs at least 3× addition -theorem gauss_le_naive (c_add c_mul : Nat) (h : 3 * c_add ≤ c_mul) : - 3 * c_mul + 5 * c_add ≤ 4 * c_mul + 2 * c_add := by omega +theorem gauss_le_naive (oracle : {ι : Type} → ArithQuery α ι → ι) + (c_add c_mul : Nat) (a b c d : α) (h : 3 * c_add ≤ c_mul) : + (complexMulGauss a b c d).cost oracle (ArithQuery.weight c_add c_mul) ≤ + (complexMulNaive a b c d).cost oracle (ArithQuery.weight c_add c_mul) := by + rw [complexMulGauss_cost, complexMulNaive_cost] + omega -theorem gauss_le_naive_iff (c_add c_mul : Nat) : - 3 * c_mul + 5 * c_add ≤ 4 * c_mul + 2 * c_add ↔ 3 * c_add ≤ c_mul := by omega +theorem gauss_le_naive_iff (oracle : {ι : Type} → ArithQuery α ι → ι) + (c_add c_mul : Nat) (a b c d : α) : + (complexMulGauss a b c d).cost oracle (ArithQuery.weight c_add c_mul) ≤ + (complexMulNaive a b c d).cost oracle (ArithQuery.weight c_add c_mul) ↔ + 3 * c_add ≤ c_mul := by + rw [complexMulGauss_cost, complexMulNaive_cost] + omega end Cslib.Query diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean index ec20c2c2f..8d7a8bf23 100644 --- a/Cslib/Algorithms/Lean/Query/FreeM.lean +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -28,8 +28,8 @@ runtime. However, pure code cannot inspect oracle responses: those enter only th `FreeM.lift`. This provides an alternative to the `TimeM`-based cost analysis in -`Cslib.Algorithms.Lean.MergeSort`: here query counting is structural (derived from the -`FreeM` tree) rather than annotation-based. +`Cslib.Algorithms.Lean.MergeSort.MergeSort`: here query counting is structural (derived from +the `FreeM` tree) rather than annotation-based. The combinatorial lower-bound lemma `FreeM.exists_countQueries_ge_clog` says: if `n` distinct oracles produce `n` distinct evaluation results from a program whose every response type has diff --git a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean index 3e4f26ea2..646ab4ace 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean @@ -8,7 +8,7 @@ module public import Cslib.Algorithms.Lean.Query.Bounds public import Cslib.Algorithms.Lean.Query.Sort.IsSort public import Cslib.Algorithms.Lean.Query.Sort.Insertion.Defs -import Mathlib.Data.List.Sort +public import Mathlib.Data.List.Sort import Mathlib.Tactic.Ring public import Mathlib.Algebra.Group.Defs diff --git a/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean b/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean index 10f3df0ec..cd6703341 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean @@ -28,12 +28,12 @@ abbrev LEQuery.ask (a b : α) : FreeM (LEQuery α) Bool := @[simp] theorem LEQuery.eval_ask (oracle : {ι : Type} → LEQuery α ι → ι) (a b : α) : (LEQuery.ask a b).eval oracle = oracle (.le a b) := rfl -/-- Build an oracle for `LEQuery α` from a binary predicate `α × α → Bool`. -/ -@[expose] def LEQuery.oracleOf (f : α × α → Bool) : {ι : Type} → LEQuery α ι → ι - | _, .le a b => f (a, b) +/-- Build an oracle for `LEQuery α` from a binary predicate `α → α → Bool`. -/ +@[expose] def LEQuery.oracleOf (f : α → α → Bool) : {ι : Type} → LEQuery α ι → ι + | _, .le a b => f a b -@[simp] theorem LEQuery.oracleOf_le (f : α × α → Bool) (a b : α) : - LEQuery.oracleOf f (.le a b) = f (a, b) := rfl +@[simp] theorem LEQuery.oracleOf_le (f : α → α → Bool) (a b : α) : + LEQuery.oracleOf f (.le a b) = f a b := rfl /-- Every `LEQuery α ι` has response type `ι = Bool`, hence a `Fintype` with cardinality 2. -/ @[reducible] def LEQuery.fintypeResponse : ∀ {ι : Type}, LEQuery α ι → Fintype ι diff --git a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean index 782e82303..6a9f882cc 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean @@ -137,7 +137,7 @@ theorem IsSort.lowerBound_infinite [Infinite α] rw [Fintype.card_perm, Fintype.card_fin] let e := Fintype.equivFinOfCardEq hcard let progOracles : Fin (Nat.factorial n) → ({ι : Type} → LEQuery α ι → ι) := - fun i => LEQuery.oracleOf (fun p => decide (infinitePermOrder n (e.symm i) p.1 p.2)) + fun i => LEQuery.oracleOf fun a b => decide (infinitePermOrder n (e.symm i) a b) -- Each oracle produces a unique sorted output have eval_eq_map (i) : (sort xs).eval (progOracles i) = (List.finRange n).map (fun k => ι ((e.symm i) k).val) := by diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean index 4b3934a63..05887b9b4 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean @@ -39,10 +39,6 @@ theorem split_perm : ∀ (xs : List α), -- goal: ((split zs).1 ++ y :: (split zs).2).Perm (y :: zs) exact (List.perm_middle).trans (List.Perm.cons _ (split_perm zs)) -theorem split_lengths_add (xs : List α) : - (split xs).1.length + (split xs).2.length = xs.length := by - simp [split_fst_length_eq, split_snd_length_eq]; omega - -- ## Evaluation simp lemmas for merge @[simp] theorem eval_merge_nil_left (oracle : {ι : Type} → LEQuery α ι → ι) (ys : List α) : From 36e098cfc04fbb8e9b44086d64ce433514ee18d4 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Tue, 1 Sep 2026 07:40:28 +0000 Subject: [PATCH 57/75] refactor(Query): apply review suggestions - convert `-- ##` section headers to `/-!` module doc comments - leave `public section` open at end of file, matching repo style - drop redundant `public` modifiers inside `public section` - insertion sort: drop dedicated perm/sorted lemmas in favour of `eval_insertionSort` + the `List.insertionSort` API - merge sort: document how `split` differs from `List.MergeSort.Internal.splitInTwo`, mark the split length lemmas `@[simp]`, inline the one-use `split_*_length_lt` lemmas into `decreasing_by`, use `~` notation, replace goal comments with `show` - lower bound: replace the `Fintype`-valued hypothesis with `Finite` + `Nat.card` Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Cy8e6HM78SVRiYRDRvASNP --- Cslib/Algorithms/Lean/Query/Arith/Defs.lean | 2 - Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean | 8 +-- Cslib/Algorithms/Lean/Query/Bounds.lean | 2 - Cslib/Algorithms/Lean/Query/FreeM.lean | 26 ++++---- .../Lean/Query/Sort/Insertion/Defs.lean | 2 - .../Lean/Query/Sort/Insertion/Lemmas.lean | 62 ++++++------------- Cslib/Algorithms/Lean/Query/Sort/IsSort.lean | 2 - Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean | 16 ++--- .../Lean/Query/Sort/LowerBound.lean | 10 ++- .../Lean/Query/Sort/Merge/Defs.lean | 24 +++---- .../Lean/Query/Sort/Merge/Lemmas.lean | 49 +++++++-------- 11 files changed, 78 insertions(+), 125 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Arith/Defs.lean b/Cslib/Algorithms/Lean/Query/Arith/Defs.lean index c80030fdc..0d9abad59 100644 --- a/Cslib/Algorithms/Lean/Query/Arith/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Arith/Defs.lean @@ -76,5 +76,3 @@ end ArithQuery return (real, imag) end Cslib.Query - -end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean index 72de6422f..97e43e6af 100644 --- a/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Arith/Lemmas.lean @@ -28,7 +28,7 @@ namespace Cslib.Query variable {α : Type} --- ## Correctness +/-! ## Correctness -/ theorem complexMulNaive_eval_honest [Add α] [Sub α] [Mul α] (a b c d : α) : (complexMulNaive a b c d).eval ArithQuery.honest = (a * c - b * d, a * d + b * c) := by @@ -39,7 +39,7 @@ theorem complexMulGauss_eval_honest [CommRing α] (a b c d : α) : simp [complexMulGauss, ArithQuery.doMul, ArithQuery.doSub, ArithQuery.doAdd, ArithQuery.honest] ring --- ## Exact cost counts +/-! ## Exact cost counts -/ theorem complexMulNaive_cost (oracle : {ι : Type} → ArithQuery α ι → ι) (c_add c_mul : Nat) (a b c d : α) : @@ -55,7 +55,7 @@ theorem complexMulGauss_cost (oracle : {ι : Type} → ArithQuery α ι → ι) simp [complexMulGauss, ArithQuery.doMul, ArithQuery.doSub, ArithQuery.doAdd, ArithQuery.weight] omega --- ## Crossover: Gauss beats naive when multiplication costs at least 3× addition +/-! ## Crossover: Gauss beats naive when multiplication costs at least 3× addition -/ theorem gauss_le_naive (oracle : {ι : Type} → ArithQuery α ι → ι) (c_add c_mul : Nat) (a b c d : α) (h : 3 * c_add ≤ c_mul) : @@ -73,5 +73,3 @@ theorem gauss_le_naive_iff (oracle : {ι : Type} → ArithQuery α ι → ι) omega end Cslib.Query - -end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Bounds.lean b/Cslib/Algorithms/Lean/Query/Bounds.lean index 3dda77669..f64d70a29 100644 --- a/Cslib/Algorithms/Lean/Query/Bounds.lean +++ b/Cslib/Algorithms/Lean/Query/Bounds.lean @@ -31,5 +31,3 @@ namespace Cslib.Query ∃ (oracle : {ι : Type} → Q ι → ι), bound n ≤ (prog x).countQueries oracle end Cslib.Query - -end -- public section diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean index 8d7a8bf23..5f2563661 100644 --- a/Cslib/Algorithms/Lean/Query/FreeM.lean +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -11,6 +11,7 @@ public import Mathlib.Combinatorics.Pigeonhole public import Mathlib.Data.Fintype.Card public import Mathlib.Data.Nat.Log public import Mathlib.Data.Set.Function +public import Mathlib.SetTheory.Cardinal.Finite /-! # FreeM: query/cost interpreters and lower-bound lemma @@ -77,7 +78,7 @@ accumulated along the oracle-determined path. Defined as `liftM` into `TimeM`. - @[expose] def countQueries (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : Nat := cost oracle (fun _ => 1) p --- Simp lemmas for eval +/-! ### Simp lemmas for `eval` -/ @[simp] theorem eval_pure (oracle : {ι : Type} → F ι → ι) (a : α) : eval oracle (pure a : FreeM F α) = a := rfl @@ -102,7 +103,7 @@ accumulated along the oracle-determined path. Defined as `liftM` into `TimeM`. - rw [← FreeM.map_eq_map, ← FreeM.bind_pure_comp, FreeM.bind_eq_bind, eval_bind] simp --- Simp lemmas for cost +/-! ### Simp lemmas for `cost` -/ @[simp] theorem cost_pure {T : Type} [AddMonoid T] (oracle : {ι : Type} → F ι → ι) (weight : {ι : Type} → F ι → T) (a : α) : @@ -142,7 +143,7 @@ accumulated along the oracle-determined path. Defined as `liftM` into `TimeM`. - rw [← FreeM.map_eq_map, ← FreeM.bind_pure_comp, FreeM.bind_eq_bind, cost_bind] simp --- Simp lemmas for countQueries +/-! ### Simp lemmas for `countQueries` -/ @[simp] theorem countQueries_pure (oracle : {ι : Type} → F ι → ι) (a : α) : countQueries oracle (pure a : FreeM F α) = 0 := rfl @@ -172,15 +173,15 @@ accumulated along the oracle-determined path. Defined as `liftM` into `TimeM`. - theorem countQueries_eq_cost_one (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : countQueries oracle p = cost oracle (fun _ => 1) p := rfl --- ## Combinatorial lower bound +/-! ## Combinatorial lower bound -/ section LowerBound /-- Finset-based version: if the oracles indexed by `S` produce `|S|`-many distinct evaluation results, then some oracle in `S` makes at least `⌈log_r |S|⌉` queries. -/ private theorem exists_mem_countQueries_ge_clog (r : Nat) - (h_fin : ∀ {ρ : Type}, F ρ → Fintype ρ) - (h_card : ∀ {ρ : Type} (op : F ρ), @Fintype.card ρ (h_fin op) ≤ r) + (h_fin : ∀ {ρ : Type}, F ρ → Finite ρ) + (h_card : ∀ {ρ : Type}, F ρ → Nat.card ρ ≤ r) {ix : Type} (p : FreeM F α) (S : Finset ix) (hS : S.Nonempty) (oracles : ix → ({ρ : Type} → F ρ → ρ)) (h_inj : Set.InjOn (fun i => p.eval (oracles i)) ↑S) : @@ -203,8 +204,11 @@ private theorem exists_mem_countQueries_ge_clog (r : Nat) exact ⟨i, hi, by simp [Nat.clog_of_left_le_one hr]⟩ push Not at hr -- 2 ≤ r, 2 ≤ S.card - let _ : Fintype ρ := h_fin op - have hk : Fintype.card ρ ≤ r := h_card op + have : Finite ρ := h_fin op + let _ : Fintype ρ := Fintype.ofFinite ρ + have hk : Fintype.card ρ ≤ r := by + rw [← Nat.card_eq_fintype_card] + exact h_card op -- Fintype.card ρ ≥ 1: any oracle produces an answer obtain ⟨i₀, _hi₀⟩ := hS have : Nonempty ρ := ⟨oracles i₀ op⟩ @@ -258,8 +262,8 @@ the adversarial/partition argument: at each query node, the `n` oracles split by answer; the largest group (size ≥ ⌈n/r⌉) still produces distinct results in the corresponding subtree, and the induction proceeds there. -/ theorem exists_countQueries_ge_clog (r : Nat) - (h_fin : ∀ {ρ : Type}, F ρ → Fintype ρ) - (h_card : ∀ {ρ : Type} (op : F ρ), @Fintype.card ρ (h_fin op) ≤ r) + (h_fin : ∀ {ρ : Type}, F ρ → Finite ρ) + (h_card : ∀ {ρ : Type}, F ρ → Nat.card ρ ≤ r) (p : FreeM F α) {n : Nat} (oracles : Fin n → ({ρ : Type} → F ρ → ρ)) (hn : 0 < n) @@ -273,5 +277,3 @@ theorem exists_countQueries_ge_clog (r : Nat) end LowerBound end Cslib.FreeM - -end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean index 7f5ab3618..ee1a64a0d 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean @@ -37,5 +37,3 @@ namespace Cslib.Query orderedInsert x sorted end Cslib.Query - -end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean index 646ab4ace..227c6de4d 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean @@ -26,7 +26,7 @@ namespace Cslib.Query variable {α : Type} --- ## Evaluation +/-! ## Evaluation -/ /-- Evaluating query-based insertion agrees with `List.orderedInsert` using the relation supplied by the oracle. -/ @@ -41,7 +41,11 @@ supplied by the oracle. -/ split <;> simp_all /-- Evaluating query-based insertion sort agrees with `List.insertionSort` using the relation -supplied by the oracle. -/ +supplied by the oracle. + +This is the essential correctness statement: it identifies the query program as *the* +insertion sort operation, so correctness properties (permutation, sortedness) transfer +directly from the `List.insertionSort` API rather than being restated here. -/ @[simp] theorem eval_insertionSort (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : (insertionSort xs).eval oracle = xs.insertionSort (fun x y => oracle (.le x y)) := by @@ -49,39 +53,7 @@ supplied by the oracle. -/ | nil => simp [insertionSort] | cons x xs ih => simp [insertionSort, ih] --- ## Permutation proofs - -theorem orderedInsert_perm (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) (xs : List α) : - ((orderedInsert x xs).eval oracle).Perm (x :: xs) := by - rw [eval_orderedInsert] - exact List.perm_orderedInsert _ _ _ - -theorem insertionSort_perm (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : - ((insertionSort xs).eval oracle).Perm xs := by - rw [eval_insertionSort] - exact List.perm_insertionSort _ _ - --- ## Sortedness proofs - -theorem orderedInsert_sorted - (r : α → α → Prop) [DecidableRel r] [Std.Total r] [IsTrans α r] - (oracle : {ι : Type} → LEQuery α ι → ι) - (horacle : ∀ a b, oracle (.le a b) = decide (r a b)) - (x : α) (xs : List α) (hxs : xs.Pairwise r) : - ((orderedInsert x xs).eval oracle).Pairwise r := by - rw [eval_orderedInsert] - simpa only [horacle, decide_eq_true_eq] using hxs.orderedInsert x xs - -theorem insertionSort_sorted - (r : α → α → Prop) [DecidableRel r] [Std.Total r] [IsTrans α r] - (oracle : {ι : Type} → LEQuery α ι → ι) - (horacle : ∀ a b, oracle (.le a b) = decide (r a b)) - (xs : List α) : - ((insertionSort xs).eval oracle).Pairwise r := by - rw [eval_insertionSort] - simpa only [horacle, decide_eq_true_eq] using List.pairwise_insertionSort r xs - --- ## Query count proofs +/-! ## Query count proofs -/ theorem orderedInsert_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) (xs : List α) : @@ -107,8 +79,9 @@ theorem insertionSort_countQueries_le (oracle : {ι : Type} → LEQuery α ι (orderedInsert x ((insertionSort xs).eval oracle)).countQueries oracle := by simp [insertionSort] rw [hq] - have hlen : ((insertionSort xs).eval oracle).length = xs.length := - (insertionSort_perm oracle xs).length_eq + have hlen : ((insertionSort xs).eval oracle).length = xs.length := by + rw [eval_insertionSort] + exact (List.perm_insertionSort _ xs).length_eq have hord := orderedInsert_countQueries_le oracle x ((insertionSort xs).eval oracle) rw [hlen] at hord have h1 := Nat.add_le_add ih hord @@ -118,20 +91,21 @@ theorem insertionSort_countQueries_le (oracle : {ι : Type} → LEQuery α ι simp only [List.length_cons] exact Nat.le_trans h1 hpow --- ## UpperBound and IsSort instances +/-! ## UpperBound and IsSort instances -/ -public theorem insertionSort_upperBound : +theorem insertionSort_upperBound : UpperBound (insertionSort (α := α)) List.length (· ^ 2) := by intro oracle n x hle exact Nat.le_trans (insertionSort_countQueries_le oracle x) (Nat.pow_le_pow_left hle 2) -public theorem insertionSort_isSort : IsSort (insertionSort (α := α)) where - perm xs oracle := insertionSort_perm oracle xs +theorem insertionSort_isSort : IsSort (insertionSort (α := α)) where + perm xs oracle := by + rw [eval_insertionSort] + exact List.perm_insertionSort _ xs sorted := by intro xs oracle r _ _ _ horacle - exact insertionSort_sorted r oracle horacle xs + rw [eval_insertionSort] + simpa only [horacle, decide_eq_true_eq] using List.pairwise_insertionSort r xs end Cslib.Query - -end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean b/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean index d71deb3b4..f768033be 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean @@ -33,5 +33,3 @@ structure IsSort (sort : List α → FreeM (LEQuery α) (List α)) : Prop where ((sort xs).eval oracle).Pairwise r end Cslib.Query - -end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean b/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean index cd6703341..07d601929 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean @@ -35,18 +35,14 @@ abbrev LEQuery.ask (a b : α) : FreeM (LEQuery α) Bool := @[simp] theorem LEQuery.oracleOf_le (f : α → α → Bool) (a b : α) : LEQuery.oracleOf f (.le a b) = f a b := rfl -/-- Every `LEQuery α ι` has response type `ι = Bool`, hence a `Fintype` with cardinality 2. -/ -@[reducible] def LEQuery.fintypeResponse : ∀ {ι : Type}, LEQuery α ι → Fintype ι - | _, .le _ _ => inferInstanceAs (Fintype Bool) +/-- Every `LEQuery α ι` has response type `ι = Bool`, hence finite. -/ +theorem LEQuery.finiteResponse : ∀ {ι : Type}, LEQuery α ι → Finite ι + | _, .le _ _ => inferInstanceAs (Finite Bool) -theorem LEQuery.cardResponse_eq_two : ∀ {ι : Type} (op : LEQuery α ι), - @Fintype.card ι (LEQuery.fintypeResponse op) = 2 - | _, .le _ _ => Fintype.card_bool +theorem LEQuery.cardResponse_eq_two : ∀ {ι : Type}, LEQuery α ι → Nat.card ι = 2 + | _, .le _ _ => Nat.card_eq_fintype_card.trans Fintype.card_bool -theorem LEQuery.cardResponse_le_two {ι : Type} (op : LEQuery α ι) : - @Fintype.card ι (LEQuery.fintypeResponse op) ≤ 2 := +theorem LEQuery.cardResponse_le_two {ι : Type} (op : LEQuery α ι) : Nat.card ι ≤ 2 := (LEQuery.cardResponse_eq_two op).le end Cslib.Query - -end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean index 6a9f882cc..3e56d3c93 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean @@ -20,7 +20,7 @@ has query complexity at least `⌈log₂(n!)⌉` for every input size `n`. The proof constructs `n!` distinct total orders on `α` (one per permutation of `n` embedded elements), shows they produce distinct sorted outputs, and applies -`FreeM.exists_countQueries_ge_clog` with `LEQuery.fintypeResponse` / +`FreeM.exists_countQueries_ge_clog` with `LEQuery.finiteResponse` / `LEQuery.cardResponse_le_two` witnessing that all responses come from `Bool` (cardinality 2). -/ @@ -31,7 +31,7 @@ public section namespace Cslib.Query --- ## infinitePermOrder: constructing n! distinct total orders +/-! ## infinitePermOrder: constructing n! distinct total orders -/ open Classical in /-- A total order on an infinite type `α` that orders `n` embedded elements @@ -121,7 +121,7 @@ private theorem map_infinite_embedding_injective [Infinite α] : have := List.map_inj_left.mp h i (List.mem_finRange i) grind --- ## Main theorem +/-! ## Main theorem -/ /-- Any correct comparison sort on an infinite type has query complexity at least `⌈log₂(n!)⌉` for every input size `n`. -/ @@ -154,10 +154,8 @@ theorem IsSort.lowerBound_infinite [Infinite α] exact e.symm.injective (map_infinite_embedding_injective h_eval) -- Apply the FreeM lower-bound lemma directly obtain ⟨i, hi⟩ := FreeM.exists_countQueries_ge_clog 2 - LEQuery.fintypeResponse LEQuery.cardResponse_le_two + LEQuery.finiteResponse LEQuery.cardResponse_le_two (sort xs) progOracles (Nat.factorial_pos n) h_inj exact ⟨progOracles i, hi⟩ end Cslib.Query - -end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean index fd2fb6838..bd268fdd1 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean @@ -23,7 +23,11 @@ public section namespace Cslib.Query -/-- Split a list into two halves by alternating elements. -/ +/-- Split a list into two halves by alternating elements. + +Unlike `List.MergeSort.Internal.splitInTwo`, which cuts the list at its midpoint, this +alternating split is structurally recursive, which makes the termination argument and the +proofs about `mergeSort` simpler. The price is that the split is not stable. -/ @[expose] def split : List α → List α × List α | [] => ([], []) | [x] => ([x], []) @@ -37,7 +41,7 @@ namespace Cslib.Query split (x :: y :: zs) = ((split zs).1 |>.cons x, (split zs).2 |>.cons y) := by simp [split] -theorem split_fst_length_eq : ∀ (xs : List α), +@[simp] theorem split_fst_length_eq : ∀ (xs : List α), (split xs).1.length = (xs.length + 1) / 2 | [] => by simp [split] | [_] => by simp [split] @@ -46,7 +50,7 @@ theorem split_fst_length_eq : ∀ (xs : List α), have := split_fst_length_eq zs omega -theorem split_snd_length_eq : ∀ (xs : List α), +@[simp] theorem split_snd_length_eq : ∀ (xs : List α), (split xs).2.length = xs.length / 2 | [] => by simp [split] | [_] => by simp [split] @@ -55,14 +59,6 @@ theorem split_snd_length_eq : ∀ (xs : List α), have := split_snd_length_eq zs omega -theorem split_fst_length_lt (x y : α) (zs : List α) : - (split (x :: y :: zs)).1.length < (x :: y :: zs).length := by - simp only [split_fst_length_eq, List.length_cons]; omega - -theorem split_snd_length_lt (x y : α) (zs : List α) : - (split (x :: y :: zs)).2.length < (x :: y :: zs).length := by - simp only [split_snd_length_eq, List.length_cons]; omega - /-- Merge two sorted lists using comparison queries. -/ @[expose] def merge (xs ys : List α) : FreeM (LEQuery α) (List α) := match xs, ys with @@ -90,9 +86,7 @@ termination_by xs.length + ys.length merge sl sr termination_by xs.length decreasing_by - · exact split_fst_length_lt x y zs - · exact split_snd_length_lt x y zs + · simp only [split_fst_length_eq, List.length_cons]; omega + · simp only [split_snd_length_eq, List.length_cons]; omega end Cslib.Query - -end -- public section diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean index 05887b9b4..706f898c5 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean @@ -18,6 +18,7 @@ All proofs are by plain equational reasoning on `FreeM.eval` and `FreeM.countQue -/ open Cslib Cslib.Query +open scoped List public section @@ -25,21 +26,21 @@ namespace Cslib.Query variable {α : Type} --- ## Split lemmas +/-! ## Split lemmas -/ theorem split_perm : ∀ (xs : List α), - ((split xs).1 ++ (split xs).2).Perm xs - | [] => List.Perm.refl _ - | [_] => List.Perm.refl _ + (split xs).1 ++ (split xs).2 ~ xs + | [] => .refl _ + | [_] => .refl _ | x :: y :: zs => by simp only [split_cons_cons] - show ((x :: (split zs).1) ++ (y :: (split zs).2)).Perm (x :: y :: zs) + show (x :: (split zs).1) ++ (y :: (split zs).2) ~ x :: y :: zs rw [List.cons_append] - refine List.Perm.cons _ ?_ - -- goal: ((split zs).1 ++ y :: (split zs).2).Perm (y :: zs) - exact (List.perm_middle).trans (List.Perm.cons _ (split_perm zs)) + refine .cons _ ?_ + show (split zs).1 ++ y :: (split zs).2 ~ y :: zs + exact (List.perm_middle).trans (.cons _ (split_perm zs)) --- ## Evaluation simp lemmas for merge +/-! ## Evaluation simp lemmas for merge -/ @[simp] theorem eval_merge_nil_left (oracle : {ι : Type} → LEQuery α ι → ι) (ys : List α) : (merge ([] : List α) ys).eval oracle = ys := by @@ -58,7 +59,7 @@ theorem split_perm : ∀ (xs : List α), simp [merge] split <;> simp_all --- ## Evaluation simp lemmas for mergeSort +/-! ## Evaluation simp lemmas for mergeSort -/ @[simp] theorem eval_mergeSort_nil (oracle : {ι : Type} → LEQuery α ι → ι) : (mergeSort (α := α) []).eval oracle = [] := by @@ -76,10 +77,10 @@ theorem split_perm : ∀ (xs : List α), ((mergeSort (split (x :: y :: zs)).2).eval oracle)).eval oracle := by simp [mergeSort] --- ## Permutation proofs +/-! ## Permutation proofs -/ theorem merge_perm (oracle : {ι : Type} → LEQuery α ι → ι) (xs ys : List α) : - ((merge xs ys).eval oracle).Perm (xs ++ ys) := by + (merge xs ys).eval oracle ~ xs ++ ys := by induction xs, ys using merge.induct (α := α) with | case1 ys => simp | case2 xs => simp @@ -87,12 +88,11 @@ theorem merge_perm (oracle : {ι : Type} → LEQuery α ι → ι) (xs ys : List simp only [eval_merge_cons_cons] split · exact List.Perm.cons _ ih_true - · -- goal: (y :: (merge (x :: xs') ys').eval oracle).Perm (x :: xs' ++ y :: ys') - -- ih: ((merge (x :: xs') ys').eval oracle).Perm ((x :: xs') ++ ys') + · show y :: (merge (x :: xs') ys').eval oracle ~ (x :: xs') ++ (y :: ys') exact (List.Perm.cons _ ih_false).trans List.perm_middle.symm theorem mergeSort_perm (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : - ((mergeSort xs).eval oracle).Perm xs := by + (mergeSort xs).eval oracle ~ xs := by induction xs using mergeSort.induct (α := α) with | case1 => simp | case2 x => simp @@ -100,16 +100,17 @@ theorem mergeSort_perm (oracle : {ι : Type} → LEQuery α ι → ι) (xs : Lis simp only [eval_mergeSort_cons_cons] exact (merge_perm oracle _ _).trans ((ih_l.append ih_r).trans (split_perm _)) --- ## Sortedness proofs +/-! ## Sortedness proofs -/ /-- If `l` is a permutation of `xs ++ ys`, and `r a` holds for all elements of `xs` and `ys`, then `r a` holds for all elements of `l`. -/ private theorem forall_mem_of_perm_append {r : α → Prop} {l xs ys : List α} - (hperm : l.Perm (xs ++ ys)) + (hperm : l ~ xs ++ ys) (hxs : ∀ z ∈ xs, r z) (hys : ∀ z ∈ ys, r z) : ∀ z ∈ l, r z := by intro z hz - rcases List.mem_append.mp (hperm.mem_iff.mp hz) with h | h + rw [hperm.mem_iff, List.mem_append] at hz + rcases hz with h | h · exact hxs z h · exact hys z h @@ -160,7 +161,7 @@ theorem mergeSort_sorted simp only [eval_mergeSort_cons_cons] exact merge_sorted r oracle horacle _ _ ih_l ih_r --- ## Query count simp lemmas +/-! ## Query count simp lemmas -/ @[simp] theorem countQueries_merge_nil_left (oracle : {ι : Type} → LEQuery α ι → ι) (ys : List α) : (merge ([] : List α) ys).countQueries oracle = 0 := by @@ -196,7 +197,7 @@ theorem mergeSort_sorted ((mergeSort (split (x :: y :: zs)).2).eval oracle)).countQueries oracle) := by simp [mergeSort] --- ## Query count proofs +/-! ## Query count proofs -/ theorem merge_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι) (xs ys : List α) : @@ -247,20 +248,18 @@ theorem mergeSort_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι exact Nat.le_trans (Nat.add_le_add ih_l (Nat.add_le_add ih_r hml)) (mergeSort_bound _ (by simp only [List.length_cons]; omega)) --- ## UpperBound and IsSort instances +/-! ## UpperBound and IsSort instances -/ -public theorem mergeSort_upperBound : +theorem mergeSort_upperBound : UpperBound (mergeSort (α := α)) List.length (fun n => n * Nat.clog 2 n) := by intro oracle n x hle exact Nat.le_trans (mergeSort_countQueries_le oracle x) (Nat.mul_le_mul hle (Nat.clog_mono_right 2 hle)) -public theorem mergeSort_isSort : IsSort (mergeSort (α := α)) where +theorem mergeSort_isSort : IsSort (mergeSort (α := α)) where perm xs oracle := mergeSort_perm oracle xs sorted := by intro xs oracle r _ _ _ horacle exact mergeSort_sorted r oracle horacle xs end Cslib.Query - -end -- public section From 2a83ed9b3fa968a89e80a164082defb94c497a17 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Tue, 1 Sep 2026 07:42:24 +0000 Subject: [PATCH 58/75] refactor(Query): make FreeM query interpreters universe polymorphic MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The interpreters generalise to `F : Type u → Type v` with programs returning `α : Type u` (the domain universe is forced by `FreeM.liftM`, whose target monad lives on `Type u`). The cost monoid `T` and the oracle index type in the lower-bound lemma live in their own universes. The sorting development stays in `Type`, since `LEQuery` responses are `Bool`. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Cy8e6HM78SVRiYRDRvASNP --- Cslib/Algorithms/Lean/Query/FreeM.lean | 80 +++++++++++++------------- 1 file changed, 41 insertions(+), 39 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean index 5f2563661..ac6008e79 100644 --- a/Cslib/Algorithms/Lean/Query/FreeM.lean +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -16,7 +16,7 @@ public import Mathlib.SetTheory.Cardinal.Finite /-! # FreeM: query/cost interpreters and lower-bound lemma This file adds query-complexity interpreters to `FreeM F α`, where the type constructor -`F : Type → Type` represents a query type mapping each query to its response type. +`F : Type u → Type v` represents a query type mapping each query to its response type. The key operations are: - `FreeM.eval oracle p`: evaluate `p` by answering each query using `oracle` @@ -45,7 +45,9 @@ open Cslib.Algorithms.Lean (TimeM) namespace Cslib.FreeM -variable {F : Type → Type} {α β : Type} +universe u v t w + +variable {F : Type u → Type v} {α β : Type u} /-! ## Interpreters @@ -65,39 +67,39 @@ property as the primary abstraction. -/ /-- Evaluate a program by answering each query using `oracle`. Defined as `liftM` to `Id`, the canonical interpreter into pure values. -/ -@[expose] def eval (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : α := +@[expose] def eval (oracle : {ι : Type u} → F ι → ι) (p : FreeM F α) : α := Id.run <| p.liftM fun i => pure (oracle i) /-- Weighted query cost in an additive monoid: each query has a cost given by `weight`, accumulated along the oracle-determined path. Defined as `liftM` into `TimeM`. -/ -@[expose] def cost {T : Type} [AddMonoid T] (oracle : {ι : Type} → F ι → ι) - (weight : {ι : Type} → F ι → T) (p : FreeM F α) : T := +@[expose] def cost {T : Type t} [AddMonoid T] (oracle : {ι : Type u} → F ι → ι) + (weight : {ι : Type u} → F ι → T) (p : FreeM F α) : T := TimeM.time <| p.liftM fun op => ⟨oracle op, weight op⟩ /-- Count the number of queries along the path determined by `oracle`. -/ -@[expose] def countQueries (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : Nat := +@[expose] def countQueries (oracle : {ι : Type u} → F ι → ι) (p : FreeM F α) : Nat := cost oracle (fun _ => 1) p /-! ### Simp lemmas for `eval` -/ -@[simp] theorem eval_pure (oracle : {ι : Type} → F ι → ι) (a : α) : +@[simp] theorem eval_pure (oracle : {ι : Type u} → F ι → ι) (a : α) : eval oracle (pure a : FreeM F α) = a := rfl -@[simp] theorem eval_liftBind (oracle : {ι : Type} → F ι → ι) - {ι : Type} (op : F ι) (cont : ι → FreeM F α) : +@[simp] theorem eval_liftBind (oracle : {ι : Type u} → F ι → ι) + {ι : Type u} (op : F ι) (cont : ι → FreeM F α) : eval oracle (FreeM.lift op >>= cont) = eval oracle (cont (oracle op)) := rfl -@[simp] theorem eval_lift (oracle : {ι : Type} → F ι → ι) {ι : Type} (op : F ι) : +@[simp] theorem eval_lift (oracle : {ι : Type u} → F ι → ι) {ι : Type u} (op : F ι) : eval oracle (FreeM.lift op) = oracle op := rfl -@[simp] theorem eval_bind (oracle : {ι : Type} → F ι → ι) +@[simp] theorem eval_bind (oracle : {ι : Type u} → F ι → ι) (t : FreeM F α) (f : α → FreeM F β) : eval oracle (t >>= f) = eval oracle (f (eval oracle t)) := by induction t with | pure a => rfl | lift_bind op cont ih => exact ih (oracle op) -@[simp] theorem eval_map (oracle : {ι : Type} → F ι → ι) +@[simp] theorem eval_map (oracle : {ι : Type u} → F ι → ι) (t : FreeM F α) (f : α → β) : eval oracle (f <$> t) = f (eval oracle t) := by rw [← FreeM.map_eq_map, ← FreeM.bind_pure_comp, FreeM.bind_eq_bind, eval_bind] @@ -105,25 +107,25 @@ accumulated along the oracle-determined path. Defined as `liftM` into `TimeM`. - /-! ### Simp lemmas for `cost` -/ -@[simp] theorem cost_pure {T : Type} [AddMonoid T] (oracle : {ι : Type} → F ι → ι) - (weight : {ι : Type} → F ι → T) (a : α) : +@[simp] theorem cost_pure {T : Type t} [AddMonoid T] (oracle : {ι : Type u} → F ι → ι) + (weight : {ι : Type u} → F ι → T) (a : α) : cost oracle weight (pure a : FreeM F α) = 0 := rfl -@[simp] theorem cost_liftBind {T : Type} [AddMonoid T] - (oracle : {ι : Type} → F ι → ι) (weight : {ι : Type} → F ι → T) - {ι : Type} (op : F ι) (cont : ι → FreeM F α) : +@[simp] theorem cost_liftBind {T : Type t} [AddMonoid T] + (oracle : {ι : Type u} → F ι → ι) (weight : {ι : Type u} → F ι → T) + {ι : Type u} (op : F ι) (cont : ι → FreeM F α) : cost oracle weight (FreeM.lift op >>= cont) = weight op + cost oracle weight (cont (oracle op)) := rfl -@[simp] theorem cost_lift {T : Type} [AddMonoid T] - (oracle : {ι : Type} → F ι → ι) (weight : {ι : Type} → F ι → T) - {ι : Type} (op : F ι) : +@[simp] theorem cost_lift {T : Type t} [AddMonoid T] + (oracle : {ι : Type u} → F ι → ι) (weight : {ι : Type u} → F ι → T) + {ι : Type u} (op : F ι) : cost oracle weight (FreeM.lift op) = weight op := by change weight op + 0 = weight op exact add_zero _ -@[simp] theorem cost_bind {T : Type} [AddMonoid T] (oracle : {ι : Type} → F ι → ι) - (weight : {ι : Type} → F ι → T) (t : FreeM F α) (f : α → FreeM F β) : +@[simp] theorem cost_bind {T : Type t} [AddMonoid T] (oracle : {ι : Type u} → F ι → ι) + (weight : {ι : Type u} → F ι → T) (t : FreeM F α) (f : α → FreeM F β) : cost oracle weight (t >>= f) = cost oracle weight t + cost oracle weight (f (eval oracle t)) := by induction t with @@ -136,8 +138,8 @@ accumulated along the oracle-determined path. Defined as `liftM` into `TimeM`. - cost oracle weight (f (eval oracle (cont (oracle op)))) simp only [ih, add_assoc] -@[simp] theorem cost_map {T : Type} [AddMonoid T] - (oracle : {ι : Type} → F ι → ι) (weight : {ι : Type} → F ι → T) +@[simp] theorem cost_map {T : Type t} [AddMonoid T] + (oracle : {ι : Type u} → F ι → ι) (weight : {ι : Type u} → F ι → T) (t : FreeM F α) (f : α → β) : cost oracle weight (f <$> t) = cost oracle weight t := by rw [← FreeM.map_eq_map, ← FreeM.bind_pure_comp, FreeM.bind_eq_bind, cost_bind] @@ -145,32 +147,32 @@ accumulated along the oracle-determined path. Defined as `liftM` into `TimeM`. - /-! ### Simp lemmas for `countQueries` -/ -@[simp] theorem countQueries_pure (oracle : {ι : Type} → F ι → ι) (a : α) : +@[simp] theorem countQueries_pure (oracle : {ι : Type u} → F ι → ι) (a : α) : countQueries oracle (pure a : FreeM F α) = 0 := rfl -@[simp] theorem countQueries_liftBind (oracle : {ι : Type} → F ι → ι) - {ι : Type} (op : F ι) (cont : ι → FreeM F α) : +@[simp] theorem countQueries_liftBind (oracle : {ι : Type u} → F ι → ι) + {ι : Type u} (op : F ι) (cont : ι → FreeM F α) : countQueries oracle (FreeM.lift op >>= cont) = 1 + countQueries oracle (cont (oracle op)) := rfl -@[simp] theorem countQueries_lift (oracle : {ι : Type} → F ι → ι) - {ι : Type} (op : F ι) : +@[simp] theorem countQueries_lift (oracle : {ι : Type u} → F ι → ι) + {ι : Type u} (op : F ι) : countQueries oracle (FreeM.lift op) = 1 := by change 1 + 0 = 1 rfl -@[simp] theorem countQueries_bind (oracle : {ι : Type} → F ι → ι) +@[simp] theorem countQueries_bind (oracle : {ι : Type u} → F ι → ι) (t : FreeM F α) (f : α → FreeM F β) : countQueries oracle (t >>= f) = countQueries oracle t + countQueries oracle (f (eval oracle t)) := cost_bind oracle (fun _ => 1) t f -@[simp] theorem countQueries_map (oracle : {ι : Type} → F ι → ι) +@[simp] theorem countQueries_map (oracle : {ι : Type u} → F ι → ι) (t : FreeM F α) (f : α → β) : countQueries oracle (f <$> t) = countQueries oracle t := cost_map oracle (fun _ => 1) t f -theorem countQueries_eq_cost_one (oracle : {ι : Type} → F ι → ι) (p : FreeM F α) : +theorem countQueries_eq_cost_one (oracle : {ι : Type u} → F ι → ι) (p : FreeM F α) : countQueries oracle p = cost oracle (fun _ => 1) p := rfl /-! ## Combinatorial lower bound -/ @@ -180,10 +182,10 @@ section LowerBound /-- Finset-based version: if the oracles indexed by `S` produce `|S|`-many distinct evaluation results, then some oracle in `S` makes at least `⌈log_r |S|⌉` queries. -/ private theorem exists_mem_countQueries_ge_clog (r : Nat) - (h_fin : ∀ {ρ : Type}, F ρ → Finite ρ) - (h_card : ∀ {ρ : Type}, F ρ → Nat.card ρ ≤ r) - {ix : Type} (p : FreeM F α) (S : Finset ix) (hS : S.Nonempty) - (oracles : ix → ({ρ : Type} → F ρ → ρ)) + (h_fin : ∀ {ρ : Type u}, F ρ → Finite ρ) + (h_card : ∀ {ρ : Type u}, F ρ → Nat.card ρ ≤ r) + {ix : Type w} (p : FreeM F α) (S : Finset ix) (hS : S.Nonempty) + (oracles : ix → ({ρ : Type u} → F ρ → ρ)) (h_inj : Set.InjOn (fun i => p.eval (oracles i)) ↑S) : ∃ i ∈ S, p.countQueries (oracles i) ≥ Nat.clog r S.card := by classical @@ -262,10 +264,10 @@ the adversarial/partition argument: at each query node, the `n` oracles split by answer; the largest group (size ≥ ⌈n/r⌉) still produces distinct results in the corresponding subtree, and the induction proceeds there. -/ theorem exists_countQueries_ge_clog (r : Nat) - (h_fin : ∀ {ρ : Type}, F ρ → Finite ρ) - (h_card : ∀ {ρ : Type}, F ρ → Nat.card ρ ≤ r) + (h_fin : ∀ {ρ : Type u}, F ρ → Finite ρ) + (h_card : ∀ {ρ : Type u}, F ρ → Nat.card ρ ≤ r) (p : FreeM F α) {n : Nat} - (oracles : Fin n → ({ρ : Type} → F ρ → ρ)) + (oracles : Fin n → ({ρ : Type u} → F ρ → ρ)) (hn : 0 < n) (h_inj : Function.Injective (fun i => p.eval (oracles i))) : ∃ i : Fin n, p.countQueries (oracles i) ≥ Nat.clog r n := by From a2e9050d8a30329c89cf51f93e81d3615653fbfb Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Tue, 1 Sep 2026 23:09:48 +0000 Subject: [PATCH 59/75] chore: golf proofs --- Cslib/Algorithms/Lean/Query/FreeM.lean | 37 +++++++++++--------------- 1 file changed, 16 insertions(+), 21 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean index ac6008e79..39e9c94e2 100644 --- a/Cslib/Algorithms/Lean/Query/FreeM.lean +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -49,6 +49,15 @@ universe u v t w variable {F : Type u → Type v} {α β : Type u} +/-- `TimeM.ret` distributes across `FreeM.liftM`. -/ +@[simp] +theorem timeMRet_liftM {T : Type t} [AddMonoid T] (interp : {ι : Type u} → F ι → TimeM T ι) + (p : FreeM F α) : + (p.liftM interp).ret = Id.run (p.liftM fun i => pure (interp i).ret) := by + induction p with + | pure => simp only [liftM_pure, TimeM.ret_pure, Id.run_pure] + | lift_bind op h ih => simp [ih] + /-! ## Interpreters All three interpreters (`eval`, `cost`, `countQueries`) are defined as `liftM` interpretations @@ -95,15 +104,12 @@ accumulated along the oracle-determined path. Defined as `liftM` into `TimeM`. - @[simp] theorem eval_bind (oracle : {ι : Type u} → F ι → ι) (t : FreeM F α) (f : α → FreeM F β) : eval oracle (t >>= f) = eval oracle (f (eval oracle t)) := by - induction t with - | pure a => rfl - | lift_bind op cont ih => exact ih (oracle op) + simp [eval] @[simp] theorem eval_map (oracle : {ι : Type u} → F ι → ι) (t : FreeM F α) (f : α → β) : eval oracle (f <$> t) = f (eval oracle t) := by - rw [← FreeM.map_eq_map, ← FreeM.bind_pure_comp, FreeM.bind_eq_bind, eval_bind] - simp + simp [eval] /-! ### Simp lemmas for `cost` -/ @@ -121,29 +127,19 @@ accumulated along the oracle-determined path. Defined as `liftM` into `TimeM`. - (oracle : {ι : Type u} → F ι → ι) (weight : {ι : Type u} → F ι → T) {ι : Type u} (op : F ι) : cost oracle weight (FreeM.lift op) = weight op := by - change weight op + 0 = weight op - exact add_zero _ + simp [cost] @[simp] theorem cost_bind {T : Type t} [AddMonoid T] (oracle : {ι : Type u} → F ι → ι) (weight : {ι : Type u} → F ι → T) (t : FreeM F α) (f : α → FreeM F β) : cost oracle weight (t >>= f) = cost oracle weight t + cost oracle weight (f (eval oracle t)) := by - induction t with - | pure a => - change cost oracle weight (f a) = 0 + cost oracle weight (f a) - simp - | lift_bind op cont ih => - change weight op + cost oracle weight (cont (oracle op) >>= f) = - (weight op + cost oracle weight (cont (oracle op))) + - cost oracle weight (f (eval oracle (cont (oracle op)))) - simp only [ih, add_assoc] + simp [cost, eval] @[simp] theorem cost_map {T : Type t} [AddMonoid T] (oracle : {ι : Type u} → F ι → ι) (weight : {ι : Type u} → F ι → T) (t : FreeM F α) (f : α → β) : cost oracle weight (f <$> t) = cost oracle weight t := by - rw [← FreeM.map_eq_map, ← FreeM.bind_pure_comp, FreeM.bind_eq_bind, cost_bind] - simp + simp [cost] /-! ### Simp lemmas for `countQueries` -/ @@ -157,9 +153,8 @@ accumulated along the oracle-determined path. Defined as `liftM` into `TimeM`. - @[simp] theorem countQueries_lift (oracle : {ι : Type u} → F ι → ι) {ι : Type u} (op : F ι) : - countQueries oracle (FreeM.lift op) = 1 := by - change 1 + 0 = 1 - rfl + countQueries oracle (FreeM.lift op) = 1 := + cost_lift _ _ _ @[simp] theorem countQueries_bind (oracle : {ι : Type u} → F ι → ι) (t : FreeM F α) (f : α → FreeM F β) : From 87278460d43be1b8485855c7e872857f2c7386db Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Tue, 1 Sep 2026 23:51:57 +0000 Subject: [PATCH 60/75] refactor: simplify InfinitePermOrder --- .../Lean/Query/Sort/LowerBound.lean | 116 +++++++++--------- 1 file changed, 57 insertions(+), 59 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean index 3e56d3c93..d1690977c 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean @@ -29,77 +29,75 @@ open Cslib Cslib.Query public section +theorem Function.Injective.extend_sum_inl_inr (f : α → β) (hf : Function.Injective f) : + Function.Injective (Function.extend f (Sum.inl : α → α ⊕ β) (Sum.inr : β → α ⊕ β)) := by + intro x y h + have h_cases (z : β) : (∃ a, f a = z) ∨ (Function.extend f Sum.inl Sum.inr z = Sum.inr z) := by + rw [Classical.or_iff_not_imp_left] + simp +contextual + rcases h_cases x with ⟨a, rfl⟩ | hx <;> rcases h_cases y with ⟨b, rfl⟩ | hy + · rw [hf.extend_apply, hf.extend_apply] at h + exact congr_arg f (Sum.inl.inj h) + · rw [hf.extend_apply, hy] at h; contradiction + · rw [hx, hf.extend_apply] at h; contradiction + · rw [hx, hy] at h + exact Sum.inr.inj h + +instance [Std.Total r] : Std.Total (InvImage r f) where + total x y := Std.Total.total (f x) (f y) + namespace Cslib.Query -/-! ## infinitePermOrder: constructing n! distinct total orders -/ +/-! ## InfinitePermOrder: constructing n! distinct total orders -/ + +/-- Distinguish `n` elements of an infinite type. -/ +private noncomputable def infinitePrefix [Infinite α] : α → Fin n ⊕ α := + Function.extend (Infinite.natEmbedding α <| Fin.val ·) .inl .inr + +@[simp, grind =] private lemma infinitePrefix_natEmbedding_finVal [Infinite α] {n : ℕ} (i : Fin n) : + infinitePrefix (Infinite.natEmbedding α i.val) = .inl i := + (Infinite.natEmbedding α).injective.comp Fin.val_injective |>.extend_apply _ _ _ + +private theorem infinitePrefix_injective [Infinite α] : + Function.Injective (infinitePrefix : α → Fin n ⊕ α) := + ((Infinite.natEmbedding α).injective.comp Fin.val_injective).extend_sum_inl_inr -open Classical in /-- A total order on an infinite type `α` that orders `n` embedded elements (via `Infinite.natEmbedding`) according to `σ⁻¹`, with embedded elements preceding all others, and a well-ordering among non-embedded elements. -/ -private noncomputable def infinitePermOrder [Infinite α] (n : Nat) - (σ : Equiv.Perm (Fin n)) (a b : α) : Prop := - if ha : ∃ i : Fin n, (Infinite.natEmbedding α) i.val = a then - if hb : ∃ j : Fin n, (Infinite.natEmbedding α) j.val = b then - σ.symm ha.choose ≤ σ.symm hb.choose - else True - else - if _ : ∃ j : Fin n, (Infinite.natEmbedding α) j.val = b then False - else @LE.le α (IsWellOrder.linearOrder (α := α) WellOrderingRel).toLE a b +private noncomputable def InfinitePermOrder [Infinite α] (n : Nat) + (σ : Equiv.Perm (Fin n)) : α → α → Prop := + letI := IsWellOrder.linearOrder (α := α) WellOrderingRel + InvImage (Sum.Lex (InvImage (· ≤ ·) σ.symm) (· ≤ ·)) infinitePrefix private noncomputable instance [Infinite α] : - DecidableRel (infinitePermOrder (α := α) n σ) := Classical.decRel _ - -private theorem infinitePermOrder.choose_eq [Infinite α] {i : Fin n} - (h : ∃ j : Fin n, (Infinite.natEmbedding α) j.val = (Infinite.natEmbedding α) i.val) : - h.choose = i := by - grind + DecidableRel (InfinitePermOrder (α := α) n σ) := Classical.decRel _ private instance [Infinite α] : - IsTrans α (infinitePermOrder (α := α) n σ) where - trans a b c hab hbc := by - let _ : LinearOrder α := IsWellOrder.linearOrder WellOrderingRel - unfold infinitePermOrder at * - by_cases ha : ∃ i : Fin n, (Infinite.natEmbedding α) i.val = a <;> - by_cases hb : ∃ j : Fin n, (Infinite.natEmbedding α) j.val = b <;> - by_cases hc : ∃ k : Fin n, (Infinite.natEmbedding α) k.val = c <;> - grind + IsTrans α (InfinitePermOrder (α := α) n σ) := by + unfold InfinitePermOrder + infer_instance private instance [Infinite α] : - Std.Total (infinitePermOrder (α := α) n σ) where - total a b := by - let _ : LinearOrder α := IsWellOrder.linearOrder WellOrderingRel - unfold infinitePermOrder - by_cases ha : ∃ i : Fin n, (Infinite.natEmbedding α) i.val = a - · simp only [dite_true_right] - grind - · simp_all only [reduceDIte, dite_eq_ite, ite_true_left] - grind - -attribute [local grind inj] Equiv.injective in + Std.Total (InfinitePermOrder (α := α) n σ) := by + unfold InfinitePermOrder + infer_instance + private instance [Infinite α] : - Std.Antisymm (infinitePermOrder (α := α) n σ) where - antisymm a b hab hba := by - let _ : LinearOrder α := IsWellOrder.linearOrder WellOrderingRel - simp only [infinitePermOrder] at hab hba - by_cases ha : ∃ i : Fin n, (Infinite.natEmbedding α) i.val = a <;> - by_cases hb : ∃ j : Fin n, (Infinite.natEmbedding α) j.val = b <;> - simp_all only [↓reduceDIte, not_exists] <;> grind - -/-- `infinitePermOrder` restricted to embedded values matches `σ⁻¹(·) ≤ σ⁻¹(·)`. -/ + Std.Antisymm (InfinitePermOrder (α := α) n σ) := by + have : Std.Antisymm (InvImage (· ≤ ·) σ.symm) := σ.symm.injective.antisymm_onFun _ + exact infinitePrefix_injective.antisymm_onFun _ + +/-- `InfinitePermOrder` restricted to embedded values matches `σ⁻¹(·) ≤ σ⁻¹(·)`. -/ @[grind =] -private theorem infinitePermOrder_on_embedded [Infinite α] {i j : Fin n} : - infinitePermOrder (α := α) n σ ((Infinite.natEmbedding α) i.val) +private theorem InfinitePermOrder_on_embedded [Infinite α] {i j : Fin n} : + InfinitePermOrder (α := α) n σ ((Infinite.natEmbedding α) i.val) ((Infinite.natEmbedding α) j.val) ↔ σ.symm i ≤ σ.symm j := by - have hi : ∃ k : Fin n, (Infinite.natEmbedding α) k.val = (Infinite.natEmbedding α) i.val := - ⟨i, rfl⟩ - have hj : ∃ k : Fin n, (Infinite.natEmbedding α) k.val = (Infinite.natEmbedding α) j.val := - ⟨j, rfl⟩ - grind [infinitePermOrder] - -/-- `map (ι ∘ Fin.val ∘ σ) (finRange n)` is pairwise sorted by `infinitePermOrder n σ`. -/ -private theorem pairwise_map_infinitePermOrder [Infinite α] (σ : Equiv.Perm (Fin n)) : - List.Pairwise (infinitePermOrder (α := α) n σ) + simp [InfinitePermOrder, InvImage] + +/-- `map (ι ∘ Fin.val ∘ σ) (finRange n)` is pairwise sorted by `InfinitePermOrder n σ`. -/ +private theorem pairwise_map_InfinitePermOrder [Infinite α] (σ : Equiv.Perm (Fin n)) : + List.Pairwise (InfinitePermOrder (α := α) n σ) ((List.finRange n).map (fun i => (Infinite.natEmbedding α) (σ i).val)) := by rw [List.pairwise_map] exact (List.pairwise_le_finRange n).imp fun hab => by grind @@ -137,16 +135,16 @@ theorem IsSort.lowerBound_infinite [Infinite α] rw [Fintype.card_perm, Fintype.card_fin] let e := Fintype.equivFinOfCardEq hcard let progOracles : Fin (Nat.factorial n) → ({ι : Type} → LEQuery α ι → ι) := - fun i => LEQuery.oracleOf fun a b => decide (infinitePermOrder n (e.symm i) a b) + fun i => LEQuery.oracleOf fun a b => decide (InfinitePermOrder n (e.symm i) a b) -- Each oracle produces a unique sorted output have eval_eq_map (i) : (sort xs).eval (progOracles i) = (List.finRange n).map (fun k => ι ((e.symm i) k).val) := by have h_perm := h.perm xs (progOracles i) have h_sorted := h.sorted xs (progOracles i) - (infinitePermOrder (α := α) n (e.symm i)) + (InfinitePermOrder (α := α) n (e.symm i)) (fun a b => by simp [progOracles]) exact h_perm.trans (map_perm_of_infinite_embedding (e.symm i)).symm |>.eq_of_pairwise' - h_sorted (pairwise_map_infinitePermOrder (e.symm i)) + h_sorted (pairwise_map_InfinitePermOrder (e.symm i)) have h_inj : Function.Injective (fun i => (sort xs).eval (progOracles i)) := by intro i j h_eval dsimp only at h_eval From 57b1c354d5447a6adfcf539c706bcdec487aadc2 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Wed, 2 Sep 2026 00:06:38 +0000 Subject: [PATCH 61/75] refactor(Query): make mergeSort agree with List.mergeSort Replace the alternating odds/evens split with the contiguous split used by List.mergeSort, so that evaluating the query program against any oracle produces literally the same list as List.mergeSort with the comparator induced by the oracle. The new eval_mergeSort identification (mirroring eval_insertionSort) lets the permutation and sortedness proofs transfer directly from the List.mergeSort API instead of being restated by hand, and makes the query-based sort stable. The n * clog 2 n query bound is unchanged: the contiguous halves have the same lengths as the alternating ones, so the counting recurrence and arithmetic are untouched. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Pxy48TaP92UgEq28KGm8BG --- .../Lean/Query/Sort/Merge/Defs.lean | 57 +++--- .../Lean/Query/Sort/Merge/Lemmas.lean | 165 +++++------------- 2 files changed, 65 insertions(+), 157 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean index bd268fdd1..30efdd248 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean @@ -10,11 +10,13 @@ public import Cslib.Algorithms.Lean.Query.Sort.LEQuery /-! # Merge Sort as a Query Program Merge sort implemented as a `FreeM (LEQuery α)`, making all comparison queries explicit. -The alternating split (odds/evens) is structurally recursive: each recursive call consumes -two constructors and operates directly on the remaining tail, so `split` needs no -well-founded recursion argument based on `List.length`. The recursive calls of `mergeSort` -itself are not structural, since the two halves are not syntactic subterms, and are justified -separately using their lengths. +The definitions mirror `List.merge` and `List.mergeSort` exactly: the list is split into +contiguous halves and the merge prefers the left element on ties. Consequently evaluating +the query program against any oracle produces literally the same list as `List.mergeSort` +with the comparator induced by the oracle (`eval_mergeSort` in +`Cslib.Algorithms.Lean.Query.Sort.Merge.Lemmas`); in particular the sort is stable. +The recursive calls of `mergeSort` are not structural, since the two halves are not +syntactic subterms, and are justified separately using their lengths. -/ open Cslib Cslib.Query @@ -23,41 +25,24 @@ public section namespace Cslib.Query -/-- Split a list into two halves by alternating elements. +/-- Split a list into contiguous halves; if the length is odd, the first half is one element +longer. This agrees with `List.MergeSort.Internal.splitInTwo`, so that `mergeSort` agrees +with `List.mergeSort`. -/ +@[expose] def split (xs : List α) : List α × List α := + (xs.take ((xs.length + 1) / 2), xs.drop ((xs.length + 1) / 2)) -Unlike `List.MergeSort.Internal.splitInTwo`, which cuts the list at its midpoint, this -alternating split is structurally recursive, which makes the termination argument and the -proofs about `mergeSort` simpler. The price is that the split is not stable. -/ -@[expose] def split : List α → List α × List α - | [] => ([], []) - | [x] => ([x], []) - | x :: y :: zs => - let (l, r) := split zs - (x :: l, y :: r) - -@[simp] theorem split_nil : split (α := α) [] = ([], []) := rfl -@[simp] theorem split_singleton (x : α) : split [x] = ([x], []) := rfl -@[simp] theorem split_cons_cons (x y : α) (zs : List α) : - split (x :: y :: zs) = ((split zs).1 |>.cons x, (split zs).2 |>.cons y) := by +@[simp] theorem split_fst_length_eq (xs : List α) : + (split xs).1.length = (xs.length + 1) / 2 := by simp [split] + omega -@[simp] theorem split_fst_length_eq : ∀ (xs : List α), - (split xs).1.length = (xs.length + 1) / 2 - | [] => by simp [split] - | [_] => by simp [split] - | _ :: _ :: zs => by - simp only [split_cons_cons, List.length_cons] - have := split_fst_length_eq zs - omega +@[simp] theorem split_snd_length_eq (xs : List α) : + (split xs).2.length = xs.length / 2 := by + simp [split] + omega -@[simp] theorem split_snd_length_eq : ∀ (xs : List α), - (split xs).2.length = xs.length / 2 - | [] => by simp [split] - | [_] => by simp [split] - | _ :: _ :: zs => by - simp only [split_cons_cons, List.length_cons] - have := split_snd_length_eq zs - omega +theorem split_fst_append_split_snd (xs : List α) : (split xs).1 ++ (split xs).2 = xs := + List.take_append_drop _ xs /-- Merge two sorted lists using comparison queries. -/ @[expose] def merge (xs ys : List α) : FreeM (LEQuery α) (List α) := diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean index 706f898c5..64fb7fb92 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean @@ -10,11 +10,17 @@ public import Cslib.Algorithms.Lean.Query.Sort.IsSort public import Cslib.Algorithms.Lean.Query.Sort.Merge.Defs public import Mathlib.Algebra.Group.Defs public import Mathlib.Data.Nat.Log +import all Init.Data.List.Sort.Basic /-! # Merge Sort: Correctness and Upper Bound Proofs that `mergeSort` is a correct comparison sort and uses at most `n * ⌈log₂ n⌉` queries. -All proofs are by plain equational reasoning on `FreeM.eval` and `FreeM.countQueries`. + +`eval_mergeSort` identifies the query program with `List.mergeSort`: evaluating against any +oracle produces the same list as `List.mergeSort` with the comparator induced by the oracle. +Correctness properties (permutation, sortedness) transfer directly from the `List.mergeSort` +API. The query bound is proved by equational reasoning on `FreeM.countQueries`, which has no +`List` counterpart. -/ open Cslib Cslib.Query @@ -26,127 +32,42 @@ namespace Cslib.Query variable {α : Type} -/-! ## Split lemmas -/ - -theorem split_perm : ∀ (xs : List α), - (split xs).1 ++ (split xs).2 ~ xs - | [] => .refl _ - | [_] => .refl _ - | x :: y :: zs => by - simp only [split_cons_cons] - show (x :: (split zs).1) ++ (y :: (split zs).2) ~ x :: y :: zs - rw [List.cons_append] - refine .cons _ ?_ - show (split zs).1 ++ y :: (split zs).2 ~ y :: zs - exact (List.perm_middle).trans (.cons _ (split_perm zs)) - -/-! ## Evaluation simp lemmas for merge -/ - -@[simp] theorem eval_merge_nil_left (oracle : {ι : Type} → LEQuery α ι → ι) (ys : List α) : - (merge ([] : List α) ys).eval oracle = ys := by - simp [merge] - -@[simp] theorem eval_merge_nil_right (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : - (merge xs ([] : List α)).eval oracle = xs := by - cases xs <;> simp [merge] - -@[simp] theorem eval_merge_cons_cons (oracle : {ι : Type} → LEQuery α ι → ι) - (x : α) (xs' : List α) (y : α) (ys' : List α) : - (merge (x :: xs') (y :: ys')).eval oracle = - if oracle (.le x y) - then x :: (merge xs' (y :: ys')).eval oracle - else y :: (merge (x :: xs') ys').eval oracle := by - simp [merge] - split <;> simp_all - -/-! ## Evaluation simp lemmas for mergeSort -/ - -@[simp] theorem eval_mergeSort_nil (oracle : {ι : Type} → LEQuery α ι → ι) : - (mergeSort (α := α) []).eval oracle = [] := by - simp [mergeSort] - -@[simp] theorem eval_mergeSort_singleton (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) : - (mergeSort [x]).eval oracle = [x] := by - simp [mergeSort] - -@[simp] theorem eval_mergeSort_cons_cons (oracle : {ι : Type} → LEQuery α ι → ι) - (x y : α) (zs : List α) : - (mergeSort (x :: y :: zs)).eval oracle = - (merge - ((mergeSort (split (x :: y :: zs)).1).eval oracle) - ((mergeSort (split (x :: y :: zs)).2).eval oracle)).eval oracle := by - simp [mergeSort] +/-! ## Evaluation -/ -/-! ## Permutation proofs -/ - -theorem merge_perm (oracle : {ι : Type} → LEQuery α ι → ι) (xs ys : List α) : - (merge xs ys).eval oracle ~ xs ++ ys := by +/-- Evaluating the query-based merge agrees with `List.merge` using the relation supplied +by the oracle. -/ +@[simp] theorem eval_merge (oracle : {ι : Type} → LEQuery α ι → ι) (xs ys : List α) : + (merge xs ys).eval oracle = xs.merge ys (fun a b => oracle (.le a b)) := by induction xs, ys using merge.induct (α := α) with - | case1 ys => simp - | case2 xs => simp + | case1 ys => simp [merge] + | case2 xs => cases xs <;> simp [merge] | case3 x xs' y ys' ih_true ih_false => - simp only [eval_merge_cons_cons] - split - · exact List.Perm.cons _ ih_true - · show y :: (merge (x :: xs') ys').eval oracle ~ (x :: xs') ++ (y :: ys') - exact (List.Perm.cons _ ih_false).trans List.perm_middle.symm - -theorem mergeSort_perm (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : - (mergeSort xs).eval oracle ~ xs := by + rw [List.cons_merge_cons] + simp [merge] + split <;> simp_all + +/-- Evaluating query-based merge sort agrees with `List.mergeSort` using the relation +supplied by the oracle. + +This is the essential correctness statement: it identifies the query program as *the* +merge sort operation, so correctness properties (permutation, sortedness, stability) +transfer directly from the `List.mergeSort` API rather than being restated here. -/ +@[simp] theorem eval_mergeSort (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : + (mergeSort xs).eval oracle = xs.mergeSort (fun a b => oracle (.le a b)) := by induction xs using mergeSort.induct (α := α) with - | case1 => simp - | case2 x => simp + | case1 => simp [mergeSort] + | case2 x => simp [mergeSort] | case3 x y zs halves ih_l ih_r => - simp only [eval_mergeSort_cons_cons] - exact (merge_perm oracle _ _).trans ((ih_l.append ih_r).trans (split_perm _)) - -/-! ## Sortedness proofs -/ + rw [List.mergeSort.eq_3] + simp [halves, split] at ih_l ih_r + simp [mergeSort, split, ih_l, ih_r] -/-- If `l` is a permutation of `xs ++ ys`, and `r a` holds for all elements of `xs` and `ys`, - then `r a` holds for all elements of `l`. -/ -private theorem forall_mem_of_perm_append {r : α → Prop} {l xs ys : List α} - (hperm : l ~ xs ++ ys) - (hxs : ∀ z ∈ xs, r z) (hys : ∀ z ∈ ys, r z) : - ∀ z ∈ l, r z := by - intro z hz - rw [hperm.mem_iff, List.mem_append] at hz - rcases hz with h | h - · exact hxs z h - · exact hys z h +/-! ## Correctness, transferred from the `List.mergeSort` API -/ -theorem merge_sorted - (r : α → α → Prop) [DecidableRel r] [Std.Total r] [IsTrans α r] - (oracle : {ι : Type} → LEQuery α ι → ι) - (horacle : ∀ a b, oracle (.le a b) = decide (r a b)) - (xs ys : List α) (hxs : xs.Pairwise r) (hys : ys.Pairwise r) : - ((merge xs ys).eval oracle).Pairwise r := by - induction xs, ys using merge.induct (α := α) with - | case1 ys => simpa - | case2 xs => simpa - | case3 x xs' y ys' ih_true ih_false => - simp only [eval_merge_cons_cons, horacle] - have hxs' := hxs.of_cons - have hys' := hys.of_cons - split - next h => - have hle : r x y := by simpa [decide_eq_true_eq] using h - refine List.pairwise_cons.mpr ⟨?_, ih_true hxs' hys⟩ - exact forall_mem_of_perm_append (merge_perm oracle xs' (y :: ys')) - (fun _ hz => List.rel_of_pairwise_cons hxs hz) - (fun z hz => by - rcases List.mem_cons.mp hz with rfl | h - · exact hle - · exact _root_.trans hle (List.rel_of_pairwise_cons hys h)) - next h => - have hle : ¬ r x y := by simpa [decide_eq_true_eq] using h - have hyx : r y x := (Std.Total.total y x).resolve_right hle - refine List.pairwise_cons.mpr ⟨?_, ih_false hxs hys'⟩ - exact forall_mem_of_perm_append (merge_perm oracle (x :: xs') ys') - (fun z hz => by - rcases List.mem_cons.mp hz with rfl | h - · exact hyx - · exact _root_.trans hyx (List.rel_of_pairwise_cons hxs h)) - (fun _ hz => List.rel_of_pairwise_cons hys hz) +theorem mergeSort_perm (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : + (mergeSort xs).eval oracle ~ xs := by + rw [eval_mergeSort] + exact List.mergeSort_perm xs _ theorem mergeSort_sorted (r : α → α → Prop) [DecidableRel r] [Std.Total r] [IsTrans α r] @@ -154,12 +75,14 @@ theorem mergeSort_sorted (horacle : ∀ a b, oracle (.le a b) = decide (r a b)) (xs : List α) : ((mergeSort xs).eval oracle).Pairwise r := by - induction xs using mergeSort.induct (α := α) with - | case1 => simp - | case2 x => simp - | case3 x y zs halves ih_l ih_r => - simp only [eval_mergeSort_cons_cons] - exact merge_sorted r oracle horacle _ _ ih_l ih_r + rw [eval_mergeSort] + refine (List.pairwise_mergeSort ?_ ?_ xs).imp (by simp [horacle]) + · intro a b c hab hbc + simp only [horacle, decide_eq_true_eq] at hab hbc ⊢ + exact _root_.trans hab hbc + · intro a b + simp only [horacle, Bool.or_eq_true, decide_eq_true_eq] + exact Std.Total.total a b /-! ## Query count simp lemmas -/ From 46d7d92095299ef27d4b317990bf97083d13af44 Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Wed, 2 Sep 2026 00:14:24 +0000 Subject: [PATCH 62/75] refactor: `Infinite` is a distraction in most of the proof --- .../Lean/Query/Sort/LowerBound.lean | 128 ++++++++++-------- 1 file changed, 69 insertions(+), 59 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean index d1690977c..e881de2ca 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean @@ -48,76 +48,83 @@ instance [Std.Total r] : Std.Total (InvImage r f) where namespace Cslib.Query -/-! ## InfinitePermOrder: constructing n! distinct total orders -/ +/-! ## PrefixPermOrder: constructing n! distinct total orders -/ -/-- Distinguish `n` elements of an infinite type. -/ -private noncomputable def infinitePrefix [Infinite α] : α → Fin n ⊕ α := - Function.extend (Infinite.natEmbedding α <| Fin.val ·) .inl .inr +open scoped Cardinal -@[simp, grind =] private lemma infinitePrefix_natEmbedding_finVal [Infinite α] {n : ℕ} (i : Fin n) : - infinitePrefix (Infinite.natEmbedding α i.val) = .inl i := - (Infinite.natEmbedding α).injective.comp Fin.val_injective |>.extend_apply _ _ _ +variable {n : ℕ} -private theorem infinitePrefix_injective [Infinite α] : - Function.Injective (infinitePrefix : α → Fin n ⊕ α) := - ((Infinite.natEmbedding α).injective.comp Fin.val_injective).extend_sum_inl_inr +/-- A constrained version of `Infinite.natEmbedding`. -/ +private noncomputable def finEmbedding (h : n ≤ #α) : Fin n ↪ α := + Nonempty.some <| by rwa [← Cardinal.le_def, Cardinal.mk_fin] -/-- A total order on an infinite type `α` that orders `n` embedded elements - (via `Infinite.natEmbedding`) according to `σ⁻¹`, with embedded elements +/-- Distinguish `n` elements of a type. -/ +private noncomputable def finPrefix (h : ↑n ≤ #α) : α → Fin n ⊕ α := + Function.extend (finEmbedding h) .inl .inr + +@[simp, grind =] private lemma finPrefix_natEmbedding_finVal (h : n ≤ #α) (i : Fin n) : + finPrefix h (finEmbedding h i) = .inl i := + (finEmbedding h).injective.extend_apply _ _ _ + +private theorem finPrefix_injective (h : ↑n ≤ #α) : + Function.Injective (finPrefix h) := + (finEmbedding h).injective.extend_sum_inl_inr + +/-- A total order on an type `α` with at least `n` elements, that orders `n` embedded elements + (via `finEmbedding) according to `σ⁻¹`, with embedded elements preceding all others, and a well-ordering among non-embedded elements. -/ -private noncomputable def InfinitePermOrder [Infinite α] (n : Nat) +private noncomputable def PrefixPermOrder (h : ↑n ≤ #α) (σ : Equiv.Perm (Fin n)) : α → α → Prop := letI := IsWellOrder.linearOrder (α := α) WellOrderingRel - InvImage (Sum.Lex (InvImage (· ≤ ·) σ.symm) (· ≤ ·)) infinitePrefix + InvImage (Sum.Lex (InvImage (· ≤ ·) σ.symm) (· ≤ ·)) (finPrefix h) -private noncomputable instance [Infinite α] : - DecidableRel (InfinitePermOrder (α := α) n σ) := Classical.decRel _ +private noncomputable instance (h : ↑n ≤ #α) : + DecidableRel (PrefixPermOrder h σ) := Classical.decRel _ -private instance [Infinite α] : - IsTrans α (InfinitePermOrder (α := α) n σ) := by - unfold InfinitePermOrder +private instance (h : ↑n ≤ #α) : + IsTrans α (PrefixPermOrder h σ) := by + unfold PrefixPermOrder infer_instance -private instance [Infinite α] : - Std.Total (InfinitePermOrder (α := α) n σ) := by - unfold InfinitePermOrder +private instance (h : ↑n ≤ #α) : + Std.Total (PrefixPermOrder h σ) := by + unfold PrefixPermOrder infer_instance -private instance [Infinite α] : - Std.Antisymm (InfinitePermOrder (α := α) n σ) := by +private instance (h : ↑n ≤ #α) : + Std.Antisymm (PrefixPermOrder h σ) := by have : Std.Antisymm (InvImage (· ≤ ·) σ.symm) := σ.symm.injective.antisymm_onFun _ - exact infinitePrefix_injective.antisymm_onFun _ + exact finPrefix_injective h |>.antisymm_onFun _ -/-- `InfinitePermOrder` restricted to embedded values matches `σ⁻¹(·) ≤ σ⁻¹(·)`. -/ +/-- `PrefixPermOrder` restricted to embedded values matches `σ⁻¹(·) ≤ σ⁻¹(·)`. -/ @[grind =] -private theorem InfinitePermOrder_on_embedded [Infinite α] {i j : Fin n} : - InfinitePermOrder (α := α) n σ ((Infinite.natEmbedding α) i.val) - ((Infinite.natEmbedding α) j.val) ↔ σ.symm i ≤ σ.symm j := by - simp [InfinitePermOrder, InvImage] - -/-- `map (ι ∘ Fin.val ∘ σ) (finRange n)` is pairwise sorted by `InfinitePermOrder n σ`. -/ -private theorem pairwise_map_InfinitePermOrder [Infinite α] (σ : Equiv.Perm (Fin n)) : - List.Pairwise (InfinitePermOrder (α := α) n σ) - ((List.finRange n).map (fun i => (Infinite.natEmbedding α) (σ i).val)) := by +private theorem PrefixPermOrder_on_embedded (h : ↑n ≤ #α) {i j : Fin n} : + PrefixPermOrder h σ (finEmbedding h i) (finEmbedding h j) ↔ σ.symm i ≤ σ.symm j := by + simp [PrefixPermOrder, InvImage] + +/-- `map (ι ∘ σ) (finRange n)` is pairwise sorted by `PrefixPermOrder n σ`. -/ +private theorem pairwise_map_PrefixPermOrder (h : ↑n ≤ #α) (σ : Equiv.Perm (Fin n)) : + List.Pairwise (PrefixPermOrder h σ) + ((List.finRange n).map (fun i => finEmbedding h (σ i))) := by rw [List.pairwise_map] exact (List.pairwise_le_finRange n).imp fun hab => by grind -/-- `map (ι ∘ Fin.val ∘ σ) (finRange n)` is a permutation of `map (ι ∘ Fin.val) (finRange n)`. -/ -private theorem map_perm_of_infinite_embedding [Infinite α] (σ : Equiv.Perm (Fin n)) : - ((List.finRange n).map (fun i => (Infinite.natEmbedding α) (σ i).val)).Perm - ((List.finRange n).map (fun i => (Infinite.natEmbedding α) i.val)) := by - rw [show (fun i => (Infinite.natEmbedding α) (σ i).val) = - (fun i => (Infinite.natEmbedding α) i.val) ∘ σ from rfl] +/-- `map (ι ∘ σ) (finRange n)` is a permutation of `map ι (finRange n)`. -/ +private theorem map_perm_of_finEmbedding (h : ↑n ≤ #α) (σ : Equiv.Perm (Fin n)) : + ((List.finRange n).map (fun i => finEmbedding h (σ i))).Perm + ((List.finRange n).map (fun i => finEmbedding h i)) := by + rw [show (fun i => finEmbedding h (σ i)) = + (fun i => finEmbedding h i) ∘ σ from rfl] grind [Equiv.Perm.map_finRange_perm] -/-- Different permutations give different `map (ι ∘ Fin.val ∘ σ) (finRange n)`. -/ -private theorem map_infinite_embedding_injective [Infinite α] : +/-- Different permutations give different `map (ι ∘ σ) (finRange n)`. -/ +private theorem map_finEmbedding_injective (h : ↑n ≤ #α) : Function.Injective (fun σ : Equiv.Perm (Fin n) => - (List.finRange n).map (fun i => (Infinite.natEmbedding α) (σ i).val)) := by + (List.finRange n).map (fun i => finEmbedding h (σ i))) := by intro σ τ h - exact Equiv.ext fun i => by - have := List.map_inj_left.mp h i (List.mem_finRange i) - grind + ext i + have := List.map_inj_left.mp h i (List.mem_finRange i) + grind /-! ## Main theorem -/ @@ -125,31 +132,34 @@ private theorem map_infinite_embedding_injective [Infinite α] : for every input size `n`. -/ theorem IsSort.lowerBound_infinite [Infinite α] {sort : List α → FreeM (LEQuery α) (List α)} - (h : IsSort sort) : + (hs : IsSort sort) : LowerBound sort List.length (fun n => Nat.clog 2 (Nat.factorial n)) := by intro n - set ι := Infinite.natEmbedding α - refine ⟨(List.finRange n).map (fun i => ι i.val), by simp, ?_⟩ - set xs := (List.finRange n).map (fun i => ι i.val) + have h : n ≤ #α := by + grw [Cardinal.natCast_le_aleph0, ← Cardinal.infinite_iff] + infer_instance + set ι := finEmbedding h + refine ⟨(List.finRange n).map ι, by simp, ?_⟩ + set xs := (List.finRange n).map ι have hcard : Fintype.card (Equiv.Perm (Fin n)) = Nat.factorial n := by rw [Fintype.card_perm, Fintype.card_fin] let e := Fintype.equivFinOfCardEq hcard let progOracles : Fin (Nat.factorial n) → ({ι : Type} → LEQuery α ι → ι) := - fun i => LEQuery.oracleOf fun a b => decide (InfinitePermOrder n (e.symm i) a b) + fun i => LEQuery.oracleOf fun a b => decide (PrefixPermOrder h (e.symm i) a b) -- Each oracle produces a unique sorted output have eval_eq_map (i) : (sort xs).eval (progOracles i) = - (List.finRange n).map (fun k => ι ((e.symm i) k).val) := by - have h_perm := h.perm xs (progOracles i) - have h_sorted := h.sorted xs (progOracles i) - (InfinitePermOrder (α := α) n (e.symm i)) + (List.finRange n).map (fun k => ι (e.symm i k)) := by + have h_perm := hs.perm xs (progOracles i) + have h_sorted := hs.sorted xs (progOracles i) + (PrefixPermOrder h (e.symm i)) (fun a b => by simp [progOracles]) - exact h_perm.trans (map_perm_of_infinite_embedding (e.symm i)).symm |>.eq_of_pairwise' - h_sorted (pairwise_map_InfinitePermOrder (e.symm i)) + exact h_perm.trans (map_perm_of_finEmbedding h (e.symm i)).symm |>.eq_of_pairwise' + h_sorted (pairwise_map_PrefixPermOrder h (e.symm i)) have h_inj : Function.Injective (fun i => (sort xs).eval (progOracles i)) := by intro i j h_eval dsimp only at h_eval rw [eval_eq_map, eval_eq_map] at h_eval - exact e.symm.injective (map_infinite_embedding_injective h_eval) + exact e.symm.injective (map_finEmbedding_injective h h_eval) -- Apply the FreeM lower-bound lemma directly obtain ⟨i, hi⟩ := FreeM.exists_countQueries_ge_clog 2 LEQuery.finiteResponse LEQuery.cardResponse_le_two From cd51b93fe3e36e8d4ed1c13e48e464a4b9fdf780 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Wed, 2 Sep 2026 01:45:26 +0000 Subject: [PATCH 63/75] feat(Query): UpperBound.of_pointwise and LowerBound.le_upperBound MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Generalize Bounds to query families Q : Type u → Type v, add a combinator deriving UpperBound from a pointwise count bound and monotonicity, and a sandwich lemma showing a LowerBound never exceeds an UpperBound for the same program. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Pxy48TaP92UgEq28KGm8BG --- Cslib/Algorithms/Lean/Query/Bounds.lean | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Bounds.lean b/Cslib/Algorithms/Lean/Query/Bounds.lean index f64d70a29..19077942d 100644 --- a/Cslib/Algorithms/Lean/Query/Bounds.lean +++ b/Cslib/Algorithms/Lean/Query/Bounds.lean @@ -6,6 +6,7 @@ Authors: Sebastian Graf, Kim Morrison, Shreyas Srinivas module public import Cslib.Algorithms.Lean.Query.FreeM +public import Mathlib.Order.Monotone.Defs /-! # Upper and Lower Bounds for Query Complexity @@ -17,10 +18,14 @@ public section namespace Cslib.Query +universe u v w + +variable {α : Type w} {Q : Type u → Type v} {β : Type u} + /-- Upper bound: for all oracles, inputs of size ≤ n make at most `bound n` queries. -/ @[expose] def UpperBound (prog : α → FreeM Q β) (size : α → Nat) (bound : Nat → Nat) : Prop := - ∀ (oracle : {ι : Type} → Q ι → ι) (n : Nat) (x : α), + ∀ (oracle : {ι : Type u} → Q ι → ι) (n : Nat) (x : α), size x ≤ n → (prog x).countQueries oracle ≤ bound n /-- Lower bound: for every size n, there exists an input of size at most n and an oracle @@ -28,6 +33,22 @@ namespace Cslib.Query @[expose] def LowerBound (prog : α → FreeM Q β) (size : α → Nat) (bound : Nat → Nat) : Prop := ∀ (n : Nat), ∃ (x : α), size x ≤ n ∧ - ∃ (oracle : {ι : Type} → Q ι → ι), bound n ≤ (prog x).countQueries oracle + ∃ (oracle : {ι : Type u} → Q ι → ι), bound n ≤ (prog x).countQueries oracle + +/-- To prove an `UpperBound` with a monotone bound function, it suffices to bound the + query count of each input by `bound` at its own size. -/ +theorem UpperBound.of_pointwise {prog : α → FreeM Q β} {size : α → Nat} {bound : Nat → Nat} + (hmono : Monotone bound) + (h : ∀ (oracle : {ι : Type u} → Q ι → ι) (x : α), + (prog x).countQueries oracle ≤ bound (size x)) : + UpperBound prog size bound := + fun oracle _n x hx => (h oracle x).trans (hmono hx) + +/-- A lower bound for a program never exceeds an upper bound for the same program and + size function. -/ +theorem LowerBound.le_upperBound {prog : α → FreeM Q β} {size : α → Nat} {l u : Nat → Nat} + (hl : LowerBound prog size l) (hu : UpperBound prog size u) (n : Nat) : l n ≤ u n := by + obtain ⟨x, hx, oracle, hbound⟩ := hl n + exact hbound.trans (hu oracle n x hx) end Cslib.Query From 901c0ceaedba1805ede6f18dd35870be422384bc Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Wed, 2 Sep 2026 01:45:26 +0000 Subject: [PATCH 64/75] docs(Query): FreeM setup recipe and countQueries design note Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Pxy48TaP92UgEq28KGm8BG --- Cslib/Algorithms/Lean/Query/FreeM.lean | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean index 39e9c94e2..4c94271bf 100644 --- a/Cslib/Algorithms/Lean/Query/FreeM.lean +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -37,6 +37,16 @@ oracles produce `n` distinct evaluation results from a program whose every respo cardinality at most `r`, then some oracle makes at least `⌈log_r n⌉` queries. The proof uses the adversarial/partition argument: at each query node, the oracles split by their answer, and the largest fiber still produces distinct results in the corresponding subtree. + +## Setting up your own query type + +1. Define an inductive `Q : Type u → Type v` whose constructors are the queries, indexed by + their response types (see `LEQuery`, `ArithQuery`). +2. Wrap each constructor with `FreeM.lift` to obtain one-step programs (`LEQuery.ask`). +3. Write algorithms in `do`-notation as values of `FreeM Q α`. +4. Prove correctness by relating `FreeM.eval` to a reference implementation, and bounds by + equational reasoning with the `countQueries`/`cost` simp lemmas; state them with + `Cslib.Query.UpperBound`/`Cslib.Query.LowerBound`. -/ public section @@ -85,7 +95,10 @@ accumulated along the oracle-determined path. Defined as `liftM` into `TimeM`. - (weight : {ι : Type u} → F ι → T) (p : FreeM F α) : T := TimeM.time <| p.liftM fun op => ⟨oracle op, weight op⟩ -/-- Count the number of queries along the path determined by `oracle`. -/ +/-- Count the number of queries along the path determined by `oracle`. + +This is deliberately a `def` with its own simp lemmas, rather than an abbreviation for +`cost oracle (fun _ => 1)`, so that goals display `countQueries`. -/ @[expose] def countQueries (oracle : {ι : Type u} → F ι → ι) (p : FreeM F α) : Nat := cost oracle (fun _ => 1) p From 877cf1a93c337cf7d74dcbd22b616f6d512b829a Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Wed, 2 Sep 2026 01:45:26 +0000 Subject: [PATCH 65/75] feat(Query): tighten insertion sort bound to n * (n - 1) / 2 The triangular bound is attained by the all-false oracle; the previous n ^ 2 bound remains as a corollary and the UpperBound instance now goes through UpperBound.of_pointwise. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Pxy48TaP92UgEq28KGm8BG --- .../Lean/Query/Sort/Insertion/Lemmas.lean | 47 +++++++++++-------- 1 file changed, 27 insertions(+), 20 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean index 227c6de4d..e64fcfa18 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean @@ -14,8 +14,9 @@ public import Mathlib.Algebra.Group.Defs /-! # Insertion Sort: Correctness and Upper Bound -Proofs that `insertionSort` is a correct comparison sort and uses at most `n²` queries. -All proofs are by plain equational reasoning on `FreeM.eval` and `FreeM.countQueries`. +Proofs that `insertionSort` is a correct comparison sort and uses at most `n * (n - 1) / 2` +queries (with `n²` as a corollary). All proofs are by plain equational reasoning on +`FreeM.eval` and `FreeM.countQueries`. -/ open Cslib Cslib.Query @@ -61,16 +62,16 @@ theorem orderedInsert_countQueries_le (oracle : {ι : Type} → LEQuery α ι induction xs with | nil => simp [orderedInsert] | cons y ys ih => - unfold orderedInsert - simp - by_cases h : oracle (.le x y) = true - · simp [h] - · simp [h] - omega + simp [orderedInsert] + by_cases h : oracle (.le x y) = true <;> simp [h] + omega +/-- Insertion sort makes at most `n * (n - 1) / 2` queries: inserting into the sorted +prefix of length `k` costs at most `k` queries. This bound is attained by the all-`false` +oracle. -/ theorem insertionSort_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : - (insertionSort xs).countQueries oracle ≤ xs.length ^ 2 := by + (insertionSort xs).countQueries oracle ≤ xs.length * (xs.length - 1) / 2 := by induction xs with | nil => simp [insertionSort] | cons x xs ih => @@ -78,26 +79,32 @@ theorem insertionSort_countQueries_le (oracle : {ι : Type} → LEQuery α ι (insertionSort xs).countQueries oracle + (orderedInsert x ((insertionSort xs).eval oracle)).countQueries oracle := by simp [insertionSort] - rw [hq] have hlen : ((insertionSort xs).eval oracle).length = xs.length := by rw [eval_insertionSort] exact (List.perm_insertionSort _ xs).length_eq have hord := orderedInsert_countQueries_le oracle x ((insertionSort xs).eval oracle) rw [hlen] at hord - have h1 := Nat.add_le_add ih hord - have hpow : xs.length ^ 2 + xs.length ≤ (xs.length + 1) ^ 2 := by - have : (xs.length + 1) ^ 2 = xs.length ^ 2 + 2 * xs.length + 1 := by ring - omega - simp only [List.length_cons] - exact Nat.le_trans h1 hpow + have htri : xs.length * (xs.length - 1) / 2 + xs.length = + (x :: xs).length * ((x :: xs).length - 1) / 2 := by + rw [← Nat.choose_two_right, ← Nat.choose_two_right, List.length_cons, + Nat.choose_succ_succ, Nat.choose_one_right, Nat.add_comm] + omega + +theorem insertionSort_countQueries_le_sq (oracle : {ι : Type} → LEQuery α ι → ι) + (xs : List α) : + (insertionSort xs).countQueries oracle ≤ xs.length ^ 2 := by + have h := insertionSort_countQueries_le oracle xs + have h2 : xs.length * (xs.length - 1) ≤ xs.length ^ 2 := by + rw [Nat.pow_two] + exact Nat.mul_le_mul_left _ (Nat.sub_le _ _) + omega /-! ## UpperBound and IsSort instances -/ theorem insertionSort_upperBound : - UpperBound (insertionSort (α := α)) List.length (· ^ 2) := by - intro oracle n x hle - exact Nat.le_trans (insertionSort_countQueries_le oracle x) - (Nat.pow_le_pow_left hle 2) + UpperBound (insertionSort (α := α)) List.length (· ^ 2) := + UpperBound.of_pointwise (fun _ _ h => Nat.pow_le_pow_left h 2) + fun oracle xs => insertionSort_countQueries_le_sq oracle xs theorem insertionSort_isSort : IsSort (insertionSort (α := α)) where perm xs oracle := by From 239b7ad7cbc14324f6b9e0b28e99ccf7ae85d2e2 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Wed, 2 Sep 2026 01:45:26 +0000 Subject: [PATCH 66/75] refactor(Query): merge sort count lemma in simp normal form State countQueries_mergeSort_cons_cons with List.mergeSort arguments (the form eval_mergeSort rewrites to), isolate the List.mergeSort.eq_3 use in a private helper linking https://github.com/leanprover/lean4/pull/14995, and derive mergeSort_upperBound through UpperBound.of_pointwise. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Pxy48TaP92UgEq28KGm8BG --- .../Lean/Query/Sort/Merge/Lemmas.lean | 34 +++++++++++++------ 1 file changed, 23 insertions(+), 11 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean index 64fb7fb92..3e572e15d 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean @@ -46,6 +46,18 @@ by the oracle. -/ simp [merge] split <;> simp_all +-- Proposed upstream as `List.mergeSort_cons_cons` in +-- https://github.com/leanprover/lean4/pull/14995; replace this private helper once the +-- toolchain includes it. Until then we derive it from the auto-generated equation lemma +-- `List.mergeSort.eq_3`, which is only visible here thanks to the (non-public) +-- `import all Init.Data.List.Sort.Basic` above. +private theorem list_mergeSort_cons_cons {le : α → α → Bool} (x y : α) (zs : List α) : + (x :: y :: zs).mergeSort le = + List.merge ((split (x :: y :: zs)).1.mergeSort le) + ((split (x :: y :: zs)).2.mergeSort le) le := by + rw [List.mergeSort.eq_3] + simp [split] + /-- Evaluating query-based merge sort agrees with `List.mergeSort` using the relation supplied by the oracle. @@ -58,7 +70,7 @@ transfer directly from the `List.mergeSort` API rather than being restated here. | case1 => simp [mergeSort] | case2 x => simp [mergeSort] | case3 x y zs halves ih_l ih_r => - rw [List.mergeSort.eq_3] + rw [list_mergeSort_cons_cons] simp [halves, split] at ih_l ih_r simp [mergeSort, split, ih_l, ih_r] @@ -116,8 +128,9 @@ theorem mergeSort_sorted (mergeSort (x :: y :: zs)).countQueries oracle = (mergeSort (split (x :: y :: zs)).1).countQueries oracle + ((mergeSort (split (x :: y :: zs)).2).countQueries oracle + - (merge ((mergeSort (split (x :: y :: zs)).1).eval oracle) - ((mergeSort (split (x :: y :: zs)).2).eval oracle)).countQueries oracle) := by + (merge ((split (x :: y :: zs)).1.mergeSort fun a b => oracle (.le a b)) + ((split (x :: y :: zs)).2.mergeSort fun a b => oracle (.le a b))).countQueries + oracle) := by simp [mergeSort] /-! ## Query count proofs -/ @@ -161,10 +174,9 @@ theorem mergeSort_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι | case3 x y zs halves ih_l ih_r => simp only [countQueries_mergeSort_cons_cons] have hml := merge_countQueries_le oracle - ((mergeSort (split (x :: y :: zs)).1).eval oracle) - ((mergeSort (split (x :: y :: zs)).2).eval oracle) - rw [(mergeSort_perm oracle (split (x :: y :: zs)).1).length_eq, - (mergeSort_perm oracle (split (x :: y :: zs)).2).length_eq, + ((split (x :: y :: zs)).1.mergeSort fun a b => oracle (.le a b)) + ((split (x :: y :: zs)).2.mergeSort fun a b => oracle (.le a b)) + rw [List.length_mergeSort, List.length_mergeSort, split_fst_length_eq, split_snd_length_eq] at hml rw [split_fst_length_eq] at ih_l rw [split_snd_length_eq] at ih_r @@ -174,10 +186,10 @@ theorem mergeSort_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι /-! ## UpperBound and IsSort instances -/ theorem mergeSort_upperBound : - UpperBound (mergeSort (α := α)) List.length (fun n => n * Nat.clog 2 n) := by - intro oracle n x hle - exact Nat.le_trans (mergeSort_countQueries_le oracle x) - (Nat.mul_le_mul hle (Nat.clog_mono_right 2 hle)) + UpperBound (mergeSort (α := α)) List.length (fun n => n * Nat.clog 2 n) := + UpperBound.of_pointwise + (fun _ _ h => Nat.mul_le_mul h (Nat.clog_mono_right 2 h)) + fun oracle xs => mergeSort_countQueries_le oracle xs theorem mergeSort_isSort : IsSort (mergeSort (α := α)) where perm xs oracle := mergeSort_perm oracle xs From 398c22bdf92161d340d43f2cee304385d8c63e96 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Wed, 2 Sep 2026 01:45:26 +0000 Subject: [PATCH 67/75] feat(Query): IsSort.eval_eq uniqueness lemma Under an oracle implementing an antisymmetric total transitive relation, all correct comparison sorts produce the same output. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Pxy48TaP92UgEq28KGm8BG --- Cslib/Algorithms/Lean/Query/Sort/IsSort.lean | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean b/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean index f768033be..26ad52f51 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/IsSort.lean @@ -6,6 +6,7 @@ Authors: Kim Morrison, Shreyas Srinivas module public import Cslib.Algorithms.Lean.Query.Sort.LEQuery +import Mathlib.Data.List.Sort /-! # IsSort: Specification for Comparison Sorts @@ -32,4 +33,15 @@ structure IsSort (sort : List α → FreeM (LEQuery α) (List α)) : Prop where (_ : ∀ a b, oracle (.le a b) = decide (r a b)), ((sort xs).eval oracle).Pairwise r +/-- `IsSort` determines the output: under an oracle implementing an antisymmetric total + transitive relation, all correct comparison sorts produce the same list. -/ +theorem IsSort.eval_eq {sort₁ sort₂ : List α → FreeM (LEQuery α) (List α)} + (h₁ : IsSort sort₁) (h₂ : IsSort sort₂) + (r : α → α → Prop) [DecidableRel r] [Std.Total r] [IsTrans α r] [Std.Antisymm r] + (oracle : {ι : Type} → LEQuery α ι → ι) + (horacle : ∀ a b, oracle (.le a b) = decide (r a b)) (xs : List α) : + (sort₁ xs).eval oracle = (sort₂ xs).eval oracle := + ((h₁.perm xs oracle).trans (h₂.perm xs oracle).symm).eq_of_pairwise' + (h₁.sorted xs oracle r horacle) (h₂.sorted xs oracle r horacle) + end Cslib.Query From 854703645c8f050252526e07c3cb450b2d1dcf86 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Wed, 2 Sep 2026 01:45:26 +0000 Subject: [PATCH 68/75] chore(Query): mark declarations proposed upstream to Mathlib private Function.Injective.extend_sum_inl_inr is proposed in https://github.com/leanprover-community/mathlib4/pull/43325 (with a golfed LeftInverse proof, mirrored here) and the Std.Total (InvImage r f) instance in https://github.com/leanprover-community/mathlib4/pull/43326; keeping the local copies private avoids conflicts when those land. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Pxy48TaP92UgEq28KGm8BG --- .../Lean/Query/Sort/LowerBound.lean | 24 ++++++++----------- 1 file changed, 10 insertions(+), 14 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean index e881de2ca..04620761c 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean @@ -29,21 +29,17 @@ open Cslib Cslib.Query public section -theorem Function.Injective.extend_sum_inl_inr (f : α → β) (hf : Function.Injective f) : +-- Proposed upstream in https://github.com/leanprover-community/mathlib4/pull/43325; +-- remove once cslib's Mathlib includes it. +private theorem Function.Injective.extend_sum_inl_inr (f : α → β) (hf : Function.Injective f) : Function.Injective (Function.extend f (Sum.inl : α → α ⊕ β) (Sum.inr : β → α ⊕ β)) := by - intro x y h - have h_cases (z : β) : (∃ a, f a = z) ∨ (Function.extend f Sum.inl Sum.inr z = Sum.inr z) := by - rw [Classical.or_iff_not_imp_left] - simp +contextual - rcases h_cases x with ⟨a, rfl⟩ | hx <;> rcases h_cases y with ⟨b, rfl⟩ | hy - · rw [hf.extend_apply, hf.extend_apply] at h - exact congr_arg f (Sum.inl.inj h) - · rw [hf.extend_apply, hy] at h; contradiction - · rw [hx, hf.extend_apply] at h; contradiction - · rw [hx, hy] at h - exact Sum.inr.inj h - -instance [Std.Total r] : Std.Total (InvImage r f) where + apply Function.LeftInverse.injective (g := Sum.elim f id) + intro x + obtain ⟨a, rfl⟩ | hx := em (∃ a, f a = x) <;> simp_all + +-- Proposed upstream in https://github.com/leanprover-community/mathlib4/pull/43326; +-- remove once cslib's Mathlib includes it. +private instance [Std.Total r] : Std.Total (InvImage r f) where total x y := Std.Total.total (f x) (f y) namespace Cslib.Query From 09c565a1c3de0d324891d00815028b97701778d9 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Wed, 2 Sep 2026 01:45:26 +0000 Subject: [PATCH 69/75] feat(Query): combined bounds for mergeSort Instantiate the comparison-sorting lower bound at mergeSort and compose it with the upper bound, yielding clog 2 n! <= n * clog 2 n for free. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Pxy48TaP92UgEq28KGm8BG --- Cslib.lean | 1 + .../Lean/Query/Sort/Merge/Bounds.lean | 38 +++++++++++++++++++ 2 files changed, 39 insertions(+) create mode 100644 Cslib/Algorithms/Lean/Query/Sort/Merge/Bounds.lean diff --git a/Cslib.lean b/Cslib.lean index b1f8b1912..7270caed3 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -11,6 +11,7 @@ public import Cslib.Algorithms.Lean.Query.Sort.Insertion.Lemmas public import Cslib.Algorithms.Lean.Query.Sort.IsSort public import Cslib.Algorithms.Lean.Query.Sort.LEQuery public import Cslib.Algorithms.Lean.Query.Sort.LowerBound +public import Cslib.Algorithms.Lean.Query.Sort.Merge.Bounds public import Cslib.Algorithms.Lean.Query.Sort.Merge.Defs public import Cslib.Algorithms.Lean.Query.Sort.Merge.Lemmas public import Cslib.Algorithms.Lean.TimeM diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Bounds.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Bounds.lean new file mode 100644 index 000000000..5af96deb3 --- /dev/null +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Bounds.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison +-/ +module + +public import Cslib.Algorithms.Lean.Query.Sort.LowerBound +public import Cslib.Algorithms.Lean.Query.Sort.Merge.Lemmas + +/-! # Merge Sort: Combined Bounds + +Instantiating the general comparison-sorting lower bound at `mergeSort`, and comparing it +with the `n * ⌈log₂ n⌉` upper bound. Since `LowerBound.le_upperBound` makes the two +bounds meet, the purely arithmetic fact `⌈log₂ n!⌉ ≤ n * ⌈log₂ n⌉` falls out of the +framework with no further work. +-/ + +open Cslib Cslib.Query + +public section + +namespace Cslib.Query + +variable {α : Type} + +/-- Merge sort has worst-case query complexity at least `⌈log₂(n!)⌉`. -/ +theorem mergeSort_lowerBound [Infinite α] : + LowerBound (mergeSort (α := α)) List.length (fun n => Nat.clog 2 (Nat.factorial n)) := + mergeSort_isSort.lowerBound_infinite + +/-- Sanity check that the bounds compose: comparing merge sort's upper and lower bounds + yields this arithmetic fact with no further work. -/ +theorem clog_factorial_le_mul_clog (n : ℕ) : + Nat.clog 2 (Nat.factorial n) ≤ n * Nat.clog 2 n := + (mergeSort_lowerBound (α := ℕ)).le_upperBound mergeSort_upperBound n + +end Cslib.Query From 6a904b2f40eeda5dee67dce6c36fbee3b0ffc36f Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Wed, 2 Sep 2026 01:45:26 +0000 Subject: [PATCH 70/75] test(Query): executable and API checks for the query framework Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Pxy48TaP92UgEq28KGm8BG --- CslibTests.lean | 1 + CslibTests/Query.lean | 59 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 60 insertions(+) create mode 100644 CslibTests/Query.lean diff --git a/CslibTests.lean b/CslibTests.lean index aa3ca1992..46f1f918f 100644 --- a/CslibTests.lean +++ b/CslibTests.lean @@ -17,5 +17,6 @@ import CslibTests.LambdaCalculus import CslibTests.MLL import CslibTests.Modal import CslibTests.Modal.Ideal +import CslibTests.Query import CslibTests.Reduction import CslibTests.StatefulProcesses diff --git a/CslibTests/Query.lean b/CslibTests/Query.lean new file mode 100644 index 000000000..3bf030d33 --- /dev/null +++ b/CslibTests/Query.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison +-/ +import Cslib.Algorithms.Lean.Query.Sort.Merge.Bounds +import Cslib.Algorithms.Lean.Query.Sort.Insertion.Lemmas +import Cslib.Algorithms.Lean.Query.Arith.Lemmas + +/-! # Tests for the query complexity framework + +Executable checks that the query programs compute, plus compile-time checks exercising +the public API (bound combinators, sort uniqueness, universe polymorphism). +-/ + +set_option linter.hashCommand false + +open Cslib Cslib.Query + +/-- The honest comparison oracle on `ℕ`. -/ +def leOracle : {ι : Type} → LEQuery ℕ ι → ι := + LEQuery.oracleOf fun a b => decide (a ≤ b) + +-- The query sorts compute, and agree with the reference sorts. +#guard (mergeSort [3, 1, 2]).eval leOracle == [1, 2, 3] +#guard (insertionSort [3, 1, 2]).eval leOracle == [1, 2, 3] + +-- Query counts along the honest path. +#guard (mergeSort [3, 1, 2]).countQueries leOracle == 3 +#guard (insertionSort [3, 1, 2]).countQueries leOracle == 3 + +-- The sharp insertion bound `n * (n - 1) / 2` is attained by the all-`false` oracle. +#guard (insertionSort [1, 2, 3]).countQueries (LEQuery.oracleOf fun _ _ => false) == 3 + +-- `mergeSort` is stable: with equal keys, payloads keep their input order. +#guard (mergeSort [(1, "b"), (0, "x"), (1, "a")]).eval + (LEQuery.oracleOf fun p q => decide (p.1 ≤ q.1)) == [(0, "x"), (1, "b"), (1, "a")] + +-- The complex multiplication examples compute. +#guard (complexMulNaive (1 : Int) 2 3 4).eval ArithQuery.honest == (-5, 10) +#guard (complexMulGauss (1 : Int) 2 3 4).eval ArithQuery.honest == (-5, 10) + +-- All correct comparison sorts agree under a linear-order oracle (`IsSort.eval_eq`). +example (xs : List ℕ) : + (mergeSort xs).eval leOracle = (insertionSort xs).eval leOracle := + mergeSort_isSort.eval_eq insertionSort_isSort (· ≤ ·) leOracle (fun _ _ => rfl) xs + +-- The sharp triangular bound for insertion sort. +example (oracle : {ι : Type} → LEQuery ℕ ι → ι) (xs : List ℕ) : + (insertionSort xs).countQueries oracle ≤ xs.length * (xs.length - 1) / 2 := + insertionSort_countQueries_le oracle xs + +-- Upper and lower bounds compose via `LowerBound.le_upperBound`. +example (n : ℕ) : Nat.clog 2 (Nat.factorial n) ≤ n * Nat.clog 2 n := + (mergeSort_lowerBound (α := ℕ)).le_upperBound mergeSort_upperBound n + +-- `UpperBound` is universe polymorphic in the query family. +example (Q : Type 1 → Type 2) (prog : Bool → FreeM Q PUnit.{2}) : Prop := + UpperBound prog (fun _ => 0) id From aee6621640e5f44e57203914849495960d8c5faa Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Wed, 2 Sep 2026 02:27:53 +0000 Subject: [PATCH 71/75] refactor(Query): mirror upstream List.mergeSort_append Replace the private cons-cons unfolding with a mirror of the mergeSort_append lemma proposed in https://github.com/leanprover/lean4/pull/14995 (merging the sorted halves of any balanced split gives mergeSort), deriving the split form from it. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Pxy48TaP92UgEq28KGm8BG --- .../Lean/Query/Sort/Merge/Lemmas.lean | 32 +++++++++++++++++-- 1 file changed, 29 insertions(+), 3 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean index 3e572e15d..4ab0d56f4 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean @@ -46,17 +46,43 @@ by the oracle. -/ simp [merge] split <;> simp_all --- Proposed upstream as `List.mergeSort_cons_cons` in +-- Proposed upstream as `List.mergeSort_append` in -- https://github.com/leanprover/lean4/pull/14995; replace this private helper once the -- toolchain includes it. Until then we derive it from the auto-generated equation lemma -- `List.mergeSort.eq_3`, which is only visible here thanks to the (non-public) -- `import all Init.Data.List.Sort.Basic` above. +private theorem list_mergeSort_append {le : α → α → Bool} (l₁ l₂ : List α) + (h₁ : l₂.length ≤ l₁.length) (h₂ : l₁.length ≤ l₂.length + 1) : + (l₁ ++ l₂).mergeSort le = List.merge (l₁.mergeSort le) (l₂.mergeSort le) le := by + match l₁, l₂ with + | [], l₂ => + obtain rfl : l₂ = [] := by simp_all + simp + | [a], [] => simp + | [a], [b] => + simp only [List.mergeSort_singleton, List.singleton_append] + rw [List.mergeSort.eq_3] + simp + | [a], b :: c :: l₂ => simp at h₁ + | a :: b :: l₁, l₂ => + rw [List.cons_append, List.cons_append, List.mergeSort.eq_3] + have hlen : (l₁.length + l₂.length + 1 + 1 + 1) / 2 = l₁.length + 2 := by + simp only [List.length_cons] at h₁ h₂ + omega + simp only [List.MergeSort.Internal.splitInTwo_fst, List.MergeSort.Internal.splitInTwo_snd, + List.length_cons, List.length_append, hlen] + congr 2 <;> simp + private theorem list_mergeSort_cons_cons {le : α → α → Bool} (x y : α) (zs : List α) : (x :: y :: zs).mergeSort le = List.merge ((split (x :: y :: zs)).1.mergeSort le) ((split (x :: y :: zs)).2.mergeSort le) le := by - rw [List.mergeSort.eq_3] - simp [split] + conv_lhs => rw [← split_fst_append_split_snd (x :: y :: zs)] + rw [list_mergeSort_append] + · simp + omega + · simp + omega /-- Evaluating query-based merge sort agrees with `List.mergeSort` using the relation supplied by the oracle. From dad82a13f1ed974f0b6e600bbef2f2f900728906 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Wed, 2 Sep 2026 03:03:48 +0000 Subject: [PATCH 72/75] chore(Query): drop unused imports Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Pxy48TaP92UgEq28KGm8BG --- Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean | 2 -- Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean | 1 - 2 files changed, 3 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean index e64fcfa18..77a5bb769 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean @@ -9,8 +9,6 @@ public import Cslib.Algorithms.Lean.Query.Bounds public import Cslib.Algorithms.Lean.Query.Sort.IsSort public import Cslib.Algorithms.Lean.Query.Sort.Insertion.Defs public import Mathlib.Data.List.Sort -import Mathlib.Tactic.Ring -public import Mathlib.Algebra.Group.Defs /-! # Insertion Sort: Correctness and Upper Bound diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean index 4ab0d56f4..43d480c6b 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean @@ -8,7 +8,6 @@ module public import Cslib.Algorithms.Lean.Query.Bounds public import Cslib.Algorithms.Lean.Query.Sort.IsSort public import Cslib.Algorithms.Lean.Query.Sort.Merge.Defs -public import Mathlib.Algebra.Group.Defs public import Mathlib.Data.Nat.Log import all Init.Data.List.Sort.Basic From 0bd0e2a33f79a31f0b3db88bf634d0c4a32f31e8 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Wed, 2 Sep 2026 08:05:29 +0000 Subject: [PATCH 73/75] refactor(Query): single cardinal bound in the lower-bound theorem Replace the separate finiteness and Nat.card hypotheses of FreeM.exists_countQueries_ge_clog with one Cardinal inequality (a natural bound on a cardinal implies finiteness), per Eric's review suggestion. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Pxy48TaP92UgEq28KGm8BG --- Cslib/Algorithms/Lean/Query/FreeM.lean | 20 +++++++++---------- Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean | 13 ++++++------ .../Lean/Query/Sort/LowerBound.lean | 7 +++---- 3 files changed, 19 insertions(+), 21 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/FreeM.lean b/Cslib/Algorithms/Lean/Query/FreeM.lean index 4c94271bf..4efa47cbd 100644 --- a/Cslib/Algorithms/Lean/Query/FreeM.lean +++ b/Cslib/Algorithms/Lean/Query/FreeM.lean @@ -52,6 +52,7 @@ and the largest fiber still produces distinct results in the corresponding subtr public section open Cslib.Algorithms.Lean (TimeM) +open scoped Cardinal namespace Cslib.FreeM @@ -190,8 +191,7 @@ section LowerBound /-- Finset-based version: if the oracles indexed by `S` produce `|S|`-many distinct evaluation results, then some oracle in `S` makes at least `⌈log_r |S|⌉` queries. -/ private theorem exists_mem_countQueries_ge_clog (r : Nat) - (h_fin : ∀ {ρ : Type u}, F ρ → Finite ρ) - (h_card : ∀ {ρ : Type u}, F ρ → Nat.card ρ ≤ r) + (h_card : ∀ {ρ : Type u}, F ρ → #ρ ≤ r) {ix : Type w} (p : FreeM F α) (S : Finset ix) (hS : S.Nonempty) (oracles : ix → ({ρ : Type u} → F ρ → ρ)) (h_inj : Set.InjOn (fun i => p.eval (oracles i)) ↑S) : @@ -214,11 +214,12 @@ private theorem exists_mem_countQueries_ge_clog (r : Nat) exact ⟨i, hi, by simp [Nat.clog_of_left_le_one hr]⟩ push Not at hr -- 2 ≤ r, 2 ≤ S.card - have : Finite ρ := h_fin op + have : Finite ρ := + Cardinal.mk_lt_aleph0_iff.mp ((h_card op).trans_lt Cardinal.natCast_lt_aleph0) let _ : Fintype ρ := Fintype.ofFinite ρ have hk : Fintype.card ρ ≤ r := by - rw [← Nat.card_eq_fintype_card] - exact h_card op + have h := h_card op + rwa [Cardinal.mk_fintype, Nat.cast_le] at h -- Fintype.card ρ ≥ 1: any oracle produces an answer obtain ⟨i₀, _hi₀⟩ := hS have : Nonempty ρ := ⟨oracles i₀ op⟩ @@ -264,22 +265,21 @@ private theorem exists_mem_countQueries_ge_clog (r : Nat) _ ≤ 1 + (cont b).countQueries (oracles i) := Nat.add_le_add_left hiq 1 /-- If `n` oracles produce `n` distinct evaluation results from a `FreeM F α` program -whose every response type is finite of cardinality at most `r`, then some oracle makes -at least `⌈log_r n⌉` queries. +whose every response type has cardinality at most `r` (and hence is finite), then some +oracle makes at least `⌈log_r n⌉` queries. This is the core combinatorial lemma for query complexity lower bounds. The proof uses the adversarial/partition argument: at each query node, the `n` oracles split by their answer; the largest group (size ≥ ⌈n/r⌉) still produces distinct results in the corresponding subtree, and the induction proceeds there. -/ theorem exists_countQueries_ge_clog (r : Nat) - (h_fin : ∀ {ρ : Type u}, F ρ → Finite ρ) - (h_card : ∀ {ρ : Type u}, F ρ → Nat.card ρ ≤ r) + (h_card : ∀ {ρ : Type u}, F ρ → #ρ ≤ r) (p : FreeM F α) {n : Nat} (oracles : Fin n → ({ρ : Type u} → F ρ → ρ)) (hn : 0 < n) (h_inj : Function.Injective (fun i => p.eval (oracles i))) : ∃ i : Fin n, p.countQueries (oracles i) ≥ Nat.clog r n := by - have ⟨i, _, hi⟩ := exists_mem_countQueries_ge_clog r h_fin h_card p Finset.univ + have ⟨i, _, hi⟩ := exists_mem_countQueries_ge_clog r h_card p Finset.univ (Finset.univ_nonempty_iff.mpr ⟨⟨0, hn⟩⟩) oracles h_inj.injOn rw [Finset.card_univ, Fintype.card_fin] at hi exact ⟨i, hi⟩ diff --git a/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean b/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean index 07d601929..48a0b40ef 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LEQuery.lean @@ -15,6 +15,8 @@ A query `LEQuery.le a b` asks whether `a ≤ b` and returns a `Bool`. public section +open scoped Cardinal + namespace Cslib.Query /-- Comparison query: asks whether `a ≤ b`, returning a `Bool`. -/ @@ -35,14 +37,11 @@ abbrev LEQuery.ask (a b : α) : FreeM (LEQuery α) Bool := @[simp] theorem LEQuery.oracleOf_le (f : α → α → Bool) (a b : α) : LEQuery.oracleOf f (.le a b) = f a b := rfl -/-- Every `LEQuery α ι` has response type `ι = Bool`, hence finite. -/ -theorem LEQuery.finiteResponse : ∀ {ι : Type}, LEQuery α ι → Finite ι - | _, .le _ _ => inferInstanceAs (Finite Bool) - -theorem LEQuery.cardResponse_eq_two : ∀ {ι : Type}, LEQuery α ι → Nat.card ι = 2 - | _, .le _ _ => Nat.card_eq_fintype_card.trans Fintype.card_bool +/-- Every `LEQuery α ι` has response type `ι = Bool`, of cardinality two. -/ +theorem LEQuery.cardResponse_eq_two : ∀ {ι : Type}, LEQuery α ι → #ι = 2 + | _, .le _ _ => Cardinal.mk_bool -theorem LEQuery.cardResponse_le_two {ι : Type} (op : LEQuery α ι) : Nat.card ι ≤ 2 := +theorem LEQuery.cardResponse_le_two {ι : Type} (op : LEQuery α ι) : #ι ≤ 2 := (LEQuery.cardResponse_eq_two op).le end Cslib.Query diff --git a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean index 04620761c..94715aa89 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/LowerBound.lean @@ -20,9 +20,8 @@ has query complexity at least `⌈log₂(n!)⌉` for every input size `n`. The proof constructs `n!` distinct total orders on `α` (one per permutation of `n` embedded elements), shows they produce distinct sorted outputs, and applies -`FreeM.exists_countQueries_ge_clog` with `LEQuery.finiteResponse` / -`LEQuery.cardResponse_le_two` witnessing that all responses come from `Bool` -(cardinality 2). +`FreeM.exists_countQueries_ge_clog` with `LEQuery.cardResponse_le_two` witnessing that +all responses come from `Bool` (cardinality 2). -/ open Cslib Cslib.Query @@ -158,7 +157,7 @@ theorem IsSort.lowerBound_infinite [Infinite α] exact e.symm.injective (map_finEmbedding_injective h h_eval) -- Apply the FreeM lower-bound lemma directly obtain ⟨i, hi⟩ := FreeM.exists_countQueries_ge_clog 2 - LEQuery.finiteResponse LEQuery.cardResponse_le_two + LEQuery.cardResponse_le_two (sort xs) progOracles (Nat.factorial_pos n) h_inj exact ⟨progOracles i, hi⟩ From b5e94cac84329c2bae4c76ab702b4cc3f1493ee0 Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Wed, 2 Sep 2026 17:24:18 +0000 Subject: [PATCH 74/75] Add monad-generic versions first --- .../Lean/Query/Sort/Insertion/Defs.lean | 34 +++++++---- .../Lean/Query/Sort/Insertion/Lemmas.lean | 17 +++--- .../Lean/Query/Sort/Merge/Defs.lean | 36 +++++++---- .../Lean/Query/Sort/Merge/Lemmas.lean | 59 ++++++++++--------- Cslib/Foundations/Control/Monad/Free.lean | 2 +- 5 files changed, 89 insertions(+), 59 deletions(-) diff --git a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean index ee1a64a0d..cb5dacb03 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Defs.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2026 Lean FRO, LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kim Morrison, Shreyas Srinivas +Authors: Kim Morrison, Shreyas Srinivas, Eric Wieser -/ module @@ -16,24 +16,38 @@ open Cslib Cslib.Query public section -namespace Cslib.Query +namespace List -/-- Insert `x` into a sorted list using comparison queries. -/ -@[expose] def orderedInsert (x : α) : List α → FreeM (LEQuery α) (List α) +variable {m} [Monad m] (cmp : α → α → m Bool) + +/-- Insert `x` into a sorted list using monadic comparisons. -/ +@[expose] def orderedInsertM (x : α) : List α → m (List α) | [] => return [x] | y :: ys => do - let le ← LEQuery.ask x y + let le ← cmp x y if le then return (x :: y :: ys) else do - let rest ← orderedInsert x ys + let rest ← orderedInsertM x ys return (y :: rest) -/-- Sort a list using insertion sort with comparison queries. -/ -@[expose] def insertionSort : List α → FreeM (LEQuery α) (List α) +/-- Sort a list using insertion sort with monadic comparisons. -/ +@[expose] def insertionSortM : List α → m (List α) | [] => return [] | x :: xs => do - let sorted ← insertionSort xs - orderedInsert x sorted + let sorted ← insertionSortM xs + orderedInsertM cmp x sorted + +end List + +namespace Cslib.Query + +/-- Insert `x` into a sorted list using comparison queries. -/ +abbrev orderedInsert (x : α) (xs : List α) : FreeM (LEQuery α) (List α) := + xs.orderedInsertM LEQuery.ask x + +/-- Sort a list using insertion sort with comparison queries. -/ +abbrev insertionSort (xs : List α) : FreeM (LEQuery α) (List α) := + xs.insertionSortM LEQuery.ask end Cslib.Query diff --git a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean index 77a5bb769..14fc9ab07 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Insertion/Lemmas.lean @@ -34,9 +34,9 @@ supplied by the oracle. -/ (orderedInsert x xs).eval oracle = xs.orderedInsert (fun x y => oracle (.le x y)) x := by induction xs with - | nil => simp [orderedInsert] + | nil => simp [List.orderedInsertM] | cons y ys ih => - simp [orderedInsert] + simp [List.orderedInsertM] split <;> simp_all /-- Evaluating query-based insertion sort agrees with `List.insertionSort` using the relation @@ -49,18 +49,19 @@ directly from the `List.insertionSort` API rather than being restated here. -/ (insertionSort xs).eval oracle = xs.insertionSort (fun x y => oracle (.le x y)) := by induction xs with - | nil => simp [insertionSort] - | cons x xs ih => simp [insertionSort, ih] + | nil => simp [List.insertionSortM] + | cons x xs ih => simp [List.insertionSortM, ih] /-! ## Query count proofs -/ theorem orderedInsert_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) (xs : List α) : (orderedInsert x xs).countQueries oracle ≤ xs.length := by + unfold orderedInsert induction xs with - | nil => simp [orderedInsert] + | nil => simp [List.orderedInsertM] | cons y ys ih => - simp [orderedInsert] + simp [List.orderedInsertM] by_cases h : oracle (.le x y) = true <;> simp [h] omega @@ -71,12 +72,12 @@ theorem insertionSort_countQueries_le (oracle : {ι : Type} → LEQuery α ι (xs : List α) : (insertionSort xs).countQueries oracle ≤ xs.length * (xs.length - 1) / 2 := by induction xs with - | nil => simp [insertionSort] + | nil => simp [List.insertionSortM] | cons x xs ih => have hq : (insertionSort (x :: xs)).countQueries oracle = (insertionSort xs).countQueries oracle + (orderedInsert x ((insertionSort xs).eval oracle)).countQueries oracle := by - simp [insertionSort] + simp [List.insertionSortM] have hlen : ((insertionSort xs).eval oracle).length = xs.length := by rw [eval_insertionSort] exact (List.perm_insertionSort _ xs).length_eq diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean index 30efdd248..094eba944 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Defs.lean @@ -23,7 +23,7 @@ open Cslib Cslib.Query public section -namespace Cslib.Query +namespace List /-- Split a list into contiguous halves; if the length is odd, the first half is one element longer. This agrees with `List.MergeSort.Internal.splitInTwo`, so that `mergeSort` agrees @@ -44,34 +44,48 @@ with `List.mergeSort`. -/ theorem split_fst_append_split_snd (xs : List α) : (split xs).1 ++ (split xs).2 = xs := List.take_append_drop _ xs -/-- Merge two sorted lists using comparison queries. -/ -@[expose] def merge (xs ys : List α) : FreeM (LEQuery α) (List α) := +variable [Monad m] (cmp : α → α → m Bool) + +/-- Merge two sorted lists using monadic comparisons. -/ +@[expose] def mergeM (xs ys : List α) : m (List α) := match xs, ys with | [], ys => return ys | xs, [] => return xs | x :: xs', y :: ys' => do - let le ← LEQuery.ask x y + let le ← cmp x y if le then do - let rest ← merge xs' (y :: ys') + let rest ← mergeM xs' (y :: ys') return (x :: rest) else do - let rest ← merge (x :: xs') ys' + let rest ← mergeM (x :: xs') ys' return (y :: rest) termination_by xs.length + ys.length -/-- Sort a list using merge sort with comparison queries. -/ -@[expose] def mergeSort (xs : List α) : FreeM (LEQuery α) (List α) := +/-- Sort a list using merge sort with monadic comparisons. -/ +@[expose] def mergeSortM (xs : List α) : m (List α) := match xs with | [] => return [] | [x] => return [x] | x :: y :: zs => do let halves := split (x :: y :: zs) - let sl ← mergeSort halves.1 - let sr ← mergeSort halves.2 - merge sl sr + let sl ← mergeSortM halves.1 + let sr ← mergeSortM halves.2 + mergeM cmp sl sr termination_by xs.length decreasing_by · simp only [split_fst_length_eq, List.length_cons]; omega · simp only [split_snd_length_eq, List.length_cons]; omega +end List + +namespace Cslib.Query + +/-- Merge two sorted lists using comparison queries. -/ +abbrev merge (xs ys : List α) : FreeM (LEQuery α) (List α) := + xs.mergeM LEQuery.ask ys + +/-- Sort a list using merge sort with comparison queries. -/ +abbrev mergeSort (xs : List α) : FreeM (LEQuery α) (List α) := + xs.mergeSortM LEQuery.ask + end Cslib.Query diff --git a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean index 43d480c6b..a5704e318 100644 --- a/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean +++ b/Cslib/Algorithms/Lean/Query/Sort/Merge/Lemmas.lean @@ -37,12 +37,12 @@ variable {α : Type} by the oracle. -/ @[simp] theorem eval_merge (oracle : {ι : Type} → LEQuery α ι → ι) (xs ys : List α) : (merge xs ys).eval oracle = xs.merge ys (fun a b => oracle (.le a b)) := by - induction xs, ys using merge.induct (α := α) with - | case1 ys => simp [merge] - | case2 xs => cases xs <;> simp [merge] + induction xs, ys using List.mergeM.induct (α := α) with + | case1 ys => simp [List.mergeM] + | case2 xs => cases xs <;> simp [List.mergeM] | case3 x xs' y ys' ih_true ih_false => rw [List.cons_merge_cons] - simp [merge] + simp [List.mergeM] split <;> simp_all -- Proposed upstream as `List.mergeSort_append` in @@ -74,9 +74,9 @@ private theorem list_mergeSort_append {le : α → α → Bool} (l₁ l₂ : Lis private theorem list_mergeSort_cons_cons {le : α → α → Bool} (x y : α) (zs : List α) : (x :: y :: zs).mergeSort le = - List.merge ((split (x :: y :: zs)).1.mergeSort le) - ((split (x :: y :: zs)).2.mergeSort le) le := by - conv_lhs => rw [← split_fst_append_split_snd (x :: y :: zs)] + List.merge ((List.split (x :: y :: zs)).1.mergeSort le) + ((List.split (x :: y :: zs)).2.mergeSort le) le := by + conv_lhs => rw [← List.split_fst_append_split_snd (x :: y :: zs)] rw [list_mergeSort_append] · simp omega @@ -91,13 +91,13 @@ merge sort operation, so correctness properties (permutation, sortedness, stabil transfer directly from the `List.mergeSort` API rather than being restated here. -/ @[simp] theorem eval_mergeSort (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : (mergeSort xs).eval oracle = xs.mergeSort (fun a b => oracle (.le a b)) := by - induction xs using mergeSort.induct (α := α) with - | case1 => simp [mergeSort] - | case2 x => simp [mergeSort] + induction xs using List.mergeSortM.induct (α := α) with + | case1 => simp [List.mergeSortM] + | case2 x => simp [List.mergeSortM] | case3 x y zs halves ih_l ih_r => rw [list_mergeSort_cons_cons] - simp [halves, split] at ih_l ih_r - simp [mergeSort, split, ih_l, ih_r] + simp [halves, List.split] at ih_l ih_r + simp [List.mergeSortM, List.split, ih_l, ih_r] /-! ## Correctness, transferred from the `List.mergeSort` API -/ @@ -125,11 +125,11 @@ theorem mergeSort_sorted @[simp] theorem countQueries_merge_nil_left (oracle : {ι : Type} → LEQuery α ι → ι) (ys : List α) : (merge ([] : List α) ys).countQueries oracle = 0 := by - simp [merge] + simp [List.mergeM] @[simp] theorem countQueries_merge_nil_right (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : (merge xs ([] : List α)).countQueries oracle = 0 := by - cases xs <;> simp [merge] + cases xs <;> simp [List.mergeM] @[simp] theorem countQueries_merge_cons_cons (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) (xs' : List α) (y : α) (ys' : List α) : @@ -137,33 +137,34 @@ theorem mergeSort_sorted 1 + if oracle (.le x y) then (merge xs' (y :: ys')).countQueries oracle else (merge (x :: xs') ys').countQueries oracle := by - simp [merge] + simp [List.mergeM] split <;> simp_all @[simp] theorem countQueries_mergeSort_nil (oracle : {ι : Type} → LEQuery α ι → ι) : (mergeSort (α := α) []).countQueries oracle = 0 := by - simp [mergeSort] + simp [List.mergeSortM] @[simp] theorem countQueries_mergeSort_singleton (oracle : {ι : Type} → LEQuery α ι → ι) (x : α) : (mergeSort [x]).countQueries oracle = 0 := by - simp [mergeSort] + simp [List.mergeSortM] +open List (split) in @[simp] theorem countQueries_mergeSort_cons_cons (oracle : {ι : Type} → LEQuery α ι → ι) (x y : α) (zs : List α) : (mergeSort (x :: y :: zs)).countQueries oracle = - (mergeSort (split (x :: y :: zs)).1).countQueries oracle + - ((mergeSort (split (x :: y :: zs)).2).countQueries oracle + - (merge ((split (x :: y :: zs)).1.mergeSort fun a b => oracle (.le a b)) - ((split (x :: y :: zs)).2.mergeSort fun a b => oracle (.le a b))).countQueries + (mergeSort (x :: y :: zs).split.1).countQueries oracle + + ((mergeSort (x :: y :: zs).split.2).countQueries oracle + + (merge ((x :: y :: zs).split.1.mergeSort fun a b => oracle (.le a b)) + ((x :: y :: zs).split.2.mergeSort fun a b => oracle (.le a b))).countQueries oracle) := by - simp [mergeSort] + simp [List.mergeSortM] /-! ## Query count proofs -/ theorem merge_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι) (xs ys : List α) : (merge xs ys).countQueries oracle ≤ xs.length + ys.length := by - induction xs, ys using merge.induct (α := α) with + induction xs, ys using List.mergeM.induct (α := α) with | case1 ys => simp | case2 xs => simp | case3 x xs' y ys' ih_true ih_false => @@ -193,18 +194,18 @@ private theorem mergeSort_bound (n : ℕ) (hn : 2 ≤ n) : theorem mergeSort_countQueries_le (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : (mergeSort xs).countQueries oracle ≤ xs.length * Nat.clog 2 xs.length := by - induction xs using mergeSort.induct (α := α) with + induction xs using List.mergeSortM.induct (α := α) with | case1 => simp [mergeSort] | case2 x => simp [mergeSort] | case3 x y zs halves ih_l ih_r => simp only [countQueries_mergeSort_cons_cons] have hml := merge_countQueries_le oracle - ((split (x :: y :: zs)).1.mergeSort fun a b => oracle (.le a b)) - ((split (x :: y :: zs)).2.mergeSort fun a b => oracle (.le a b)) + ((x :: y :: zs).split.1.mergeSort fun a b => oracle (.le a b)) + ((x :: y :: zs).split.2.mergeSort fun a b => oracle (.le a b)) rw [List.length_mergeSort, List.length_mergeSort, - split_fst_length_eq, split_snd_length_eq] at hml - rw [split_fst_length_eq] at ih_l - rw [split_snd_length_eq] at ih_r + List.split_fst_length_eq, List.split_snd_length_eq] at hml + rw [List.split_fst_length_eq] at ih_l + rw [List.split_snd_length_eq] at ih_r exact Nat.le_trans (Nat.add_le_add ih_l (Nat.add_le_add ih_r hml)) (mergeSort_bound _ (by simp only [List.length_cons]; omega)) diff --git a/Cslib/Foundations/Control/Monad/Free.lean b/Cslib/Foundations/Control/Monad/Free.lean index 09d550b8b..c3e69b1d9 100644 --- a/Cslib/Foundations/Control/Monad/Free.lean +++ b/Cslib/Foundations/Control/Monad/Free.lean @@ -246,7 +246,7 @@ lemma liftM_bind [LawfulMonad m] @[simp] lemma liftM_map [LawfulMonad m] (interp : {ι : Type u} → F ι → m ι) (f : α → β) (x : FreeM F α) : - (f <$> x).liftM interp = f <$> x.liftM interp := by + (f <$> x).liftM @interp = f <$> x.liftM @interp := by simp_rw [← LawfulMonad.bind_pure_comp, liftM_bind, liftM_pure] @[simp] From f6d8269843899e0388d6be7416a3f3843af99b95 Mon Sep 17 00:00:00 2001 From: Kim Morrison Date: Sat, 5 Sep 2026 01:38:03 +0000 Subject: [PATCH 75/75] test(Query): naturality of the monad-generic sorts The generic List.orderedInsertM/insertionSortM commute with any monad morphism, stated with the IsMonadHom laws of https://github.com/leanprover/cslib/pull/856 inlined and needing no lawfulness on either side. Since evaluation against an oracle is a monad morphism to Id, the executable Id instantiation is List.insertionSort with no separate proof about the generic definition, and the framework's complexity bounds apply to the generic program definitionally. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_01Pxy48TaP92UgEq28KGm8BG --- CslibTests.lean | 1 + CslibTests/QueryMonadicStyle.lean | 82 +++++++++++++++++++++++++++++++ 2 files changed, 83 insertions(+) create mode 100644 CslibTests/QueryMonadicStyle.lean diff --git a/CslibTests.lean b/CslibTests.lean index 46f1f918f..9e3e5e650 100644 --- a/CslibTests.lean +++ b/CslibTests.lean @@ -18,5 +18,6 @@ import CslibTests.MLL import CslibTests.Modal import CslibTests.Modal.Ideal import CslibTests.Query +import CslibTests.QueryMonadicStyle import CslibTests.Reduction import CslibTests.StatefulProcesses diff --git a/CslibTests/QueryMonadicStyle.lean b/CslibTests/QueryMonadicStyle.lean new file mode 100644 index 000000000..691db70fc --- /dev/null +++ b/CslibTests/QueryMonadicStyle.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison +-/ +import Cslib.Algorithms.Lean.Query.Sort.Insertion.Lemmas + +/-! # Naturality of the monad-generic sorts + +`List.orderedInsertM` and `List.insertionSortM` are generic over the monad supplying the +comparator, and the query programs are their instantiations at `FreeM (LEQuery α)`. This +file proves the generic programs are natural in the monad: any monad morphism commutes +with them. The morphism laws are stated inline; they are the fields of `IsMonadHom` from +https://github.com/leanprover/cslib/pull/856. No lawfulness of either monad is needed. + +Since evaluation against an oracle is a monad morphism `FreeM (LEQuery α) → Id`, +naturality identifies the executable `Id` instantiation with `List.insertionSort`, with +no separate proof about the generic definition; and because the query programs are +definitional instantiations, the framework's complexity bounds apply to the generic +programs unchanged. +-/ + +open Cslib Cslib.Query + +universe v w + +section Naturality + +variable {α : Type} {m : Type → Type v} [Monad m] {n : Type → Type w} [Monad n] + (φ : ∀ {β}, m β → n β) + (hpure : ∀ {β} (a : β), φ (pure a) = pure a) + (hbind : ∀ {β γ} (x : m β) (f : β → m γ), φ (x >>= f) = φ x >>= (φ <| f ·)) + +include hpure hbind + +theorem List.orderedInsertM_naturality (cmp : α → α → m Bool) (x : α) (xs : List α) : + φ (xs.orderedInsertM cmp x) = xs.orderedInsertM (fun a b => φ (cmp a b)) x := by + induction xs with + | nil => simp [List.orderedInsertM, hpure] + | cons y ys ih => + simp only [List.orderedInsertM, hbind] + congr 1 + funext b + cases b <;> simp [hbind, hpure, ih] + +theorem List.insertionSortM_naturality (cmp : α → α → m Bool) (xs : List α) : + φ (xs.insertionSortM cmp) = xs.insertionSortM (fun a b => φ (cmp a b)) := by + induction xs with + | nil => simp [List.insertionSortM, hpure] + | cons x xs ih => + simp only [List.insertionSortM, hbind, ih, List.orderedInsertM_naturality φ hpure hbind] + +end Naturality + +/-! ## Consequences of naturality -/ + +variable {α : Type} + +/-- Evaluation against an oracle is a monad morphism to `Id`, so by naturality the +`Id` instantiation of the generic program is the evaluation of the query program. -/ +theorem insertionSortM_eval (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : + (insertionSort xs).eval oracle = + xs.insertionSortM (m := Id) fun a b => oracle (.le a b) := + List.insertionSortM_naturality (m := FreeM (LEQuery α)) (n := Id) + (fun {_} p => FreeM.eval oracle p) + (fun _ => rfl) (fun x f => FreeM.eval_bind oracle x f) _ xs + +/-- The executable `Id` instantiation of the generic program is `List.insertionSort`. -/ +example (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : + xs.insertionSortM (m := Id) (fun a b => oracle (.le a b)) = + xs.insertionSort fun a b => oracle (.le a b) := by + rw [← insertionSortM_eval, eval_insertionSort] + +/-- The query-complexity bound applies to the generic program at its query +instantiation, definitionally. -/ +example (oracle : {ι : Type} → LEQuery α ι → ι) (xs : List α) : + (xs.insertionSortM LEQuery.ask).countQueries oracle ≤ + xs.length * (xs.length - 1) / 2 := + insertionSort_countQueries_le oracle xs + +example : Id.run ([3, 1, 2].insertionSortM fun a b : Nat => pure (decide (a ≤ b))) = + [1, 2, 3] := by decide