From 7c47d30bab2ea45952a1e58ddf65f2e0ae422c64 Mon Sep 17 00:00:00 2001 From: Tanner Duve Date: Fri, 5 Dec 2025 15:11:56 -0800 Subject: [PATCH 001/176] initial commit --- Cslib/Algorithms/MergeSort/MergeSort.lean | 66 +++++++++++++ Cslib/Algorithms/QueryModel.lean | 98 +++++++++++++++++++ .../Control/Monad/Free/Effects.lean | 38 ++++++- Cslib/Foundations/Control/Monad/Time.lean | 82 ++++++++++++++++ 4 files changed, 282 insertions(+), 2 deletions(-) create mode 100644 Cslib/Algorithms/MergeSort/MergeSort.lean create mode 100644 Cslib/Algorithms/QueryModel.lean create mode 100644 Cslib/Foundations/Control/Monad/Time.lean diff --git a/Cslib/Algorithms/MergeSort/MergeSort.lean b/Cslib/Algorithms/MergeSort/MergeSort.lean new file mode 100644 index 000000000..cee93ffaa --- /dev/null +++ b/Cslib/Algorithms/MergeSort/MergeSort.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2025 Tanner Duve. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tanner Duve +-/ + +import Cslib.Algorithms.QueryModel + +/-! +# Merge sort in the query model + +This file implements merge sort as a program in the query model defined in +`Cslib.Algorithms.QueryModel`. The algorithm uses only comparison queries. + +## Main definitions + +- `merge` : merge step using `Prog` comparisons +- `split` : split a list in two by alternating elements +- `mergeSort` : merge sort expressed in the query model + +We also provide simple example evaluations of `mergeSort` and its time cost. +-/ + +open Cslib + +namespace Cslib.Algorithms.MergeSort.QueryBased + +open Cslib.Algorithms + +/-- Merge two sorted lists using comparisons in the query monad. -/ +def merge : List Nat → List Nat → Prog (List Nat) + | [], ys => pure ys + | xs, [] => pure xs + | x :: xs', y :: ys' => do + let b ← cmpVal x y + if b then + let rest ← merge xs' (y :: ys') + pure (x :: rest) + else + let rest ← merge (x :: xs') ys' + pure (y :: rest) + +/-- Split a list into two lists by alternating elements. -/ +def split (xs : List Nat) : List Nat × List Nat := + let rec go : List Nat → List Nat → List Nat → List Nat × List Nat + | [], accL, accR => (accL.reverse, accR.reverse) + | [x], accL, accR => ((x :: accL).reverse, accR.reverse) + | x :: y :: xs, accL, accR => go xs (x :: accL) (y :: accR) + go xs [] [] + +/-- Merge sort expressed as a program in the query model. -/ +partial def mergeSort : List Nat → Prog (List Nat) + | [] => pure [] + | [x] => pure [x] + | xs => + let (left, right) := split xs + do + let sortedLeft ← mergeSort left + let sortedRight ← mergeSort right + merge sortedLeft sortedRight + +#eval evalProg (mergeSort [5,3,8,6,2,7,4,1]) +#eval timeProg (mergeSort [5,3,8,6,2,7,4,1]) + +end Cslib.Algorithms.MergeSort.QueryBased + diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean new file mode 100644 index 000000000..d89c55d59 --- /dev/null +++ b/Cslib/Algorithms/QueryModel.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2025 Tanner Duve. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tanner Duve, Sorrachai Yingchareonthawornhcai +-/ + +import Cslib.Foundations.Control.Monad.Free.Effects +import Cslib.Foundations.Control.Monad.Free.Fold +import Cslib.Foundations.Control.Monad.Time + +/- +# Query model for comparison-based algorithms + +This file defines a simple query language for reading, writing, and comparing natural numbers, +modeled as a free monad over primitive query operations. + +We equip this language with a cost model (`TimeM`) that counts how many primitive queries +are performed. An example algorithm (merge sort) is implemented in +`Cslib.Algorithms.MergeSort.QueryBased`. + +## Main definitions + +- `QueryF` : functor of primitive query operations +- `Prog` : free monad of query programs +- `timeOfQuery`, `timeInterp`, `timeProg` : cost model for programs +- `evalProg` : concrete execution semantics for programs + +## Tags + +query model, free monad, time complexity, merge sort +-/ + +open Cslib + +/-- Primitive queries on natural-number registers. -/ +inductive QueryF : Type → Type where + /-- Read the value stored at index `i`. -/ + | read : Nat → QueryF Nat + /-- Write value `v` at index `i`. -/ + | write : Nat → Nat → QueryF PUnit + /-- Compare the values at indices `i` and `j`. -/ + | cmp : Nat → Nat → QueryF Bool + +/-- Programs built as the free monad over `QueryF`. -/ +abbrev Prog (α : Type) := FreeM QueryF α + +namespace Prog + +/-- Lift a comparison on values into the free monad. -/ +def cmpVal (x y : Nat) : Prog Bool := + FreeM.lift (QueryF.cmp x y) + +/-- Conditional branching on a boolean program. -/ +def cond {α} (b : Prog Bool) (t e : Prog α) : Prog α := + b.bind (fun b' => if b' then t else e) + +/-- A counting loop from `0` to `n - 1`, sequencing the body. -/ +def forLoop (n : Nat) (body : Nat → Prog PUnit) : Prog PUnit := + let rec go : Nat → Prog PUnit + | 0 => pure () + | i + 1 => + body i >>= fun _ => go i + go n + +end Prog + +/-- Constant time cost assigned to each primitive query. -/ +def timeOfQuery : {ι : Type} → QueryF ι → Nat + | _, .read _ => 1 + | _, .write _ _ => 1 + | _, .cmp _ _ => 1 + +/-- Interpret primitive queries into the time-counting monad `TimeM`. -/ +def timeInterp : {ι : Type} → QueryF ι → TimeM ι + | _, .read i => TimeM.tick 0 (timeOfQuery (.read i)) + | _, .write i v => TimeM.tick PUnit.unit (timeOfQuery (.write i v)) + | _, .cmp i j => TimeM.tick false (timeOfQuery (.cmp i j)) + +/-- Total time cost of running a program under the interpreter `timeInterp`. -/ +def timeProg {α : Type} (p : Prog α) : Nat := + (p.liftM timeInterp).time + +/-- Lift a comparison into the query language at the top level. -/ +def cmpVal (x y : Nat) : Prog Bool := + FreeM.lift (QueryF.cmp x y) + +/-- Concrete semantics for primitive queries, used to run programs. -/ +def evalQuery : {ι : Type} → QueryF ι → ι + | _, .read _ => 0 + | _, .write _ _ => PUnit.unit + | _, .cmp x y => x ≤ y + +/-- Evaluate a query program to a pure value using `evalQuery`. -/ +def evalProg {α : Type} (p : Prog α) : α := + FreeM.foldFreeM id + (fun {ι} (op : QueryF ι) (k : ι → α) => + k (evalQuery op)) + p diff --git a/Cslib/Foundations/Control/Monad/Free/Effects.lean b/Cslib/Foundations/Control/Monad/Free/Effects.lean index 6e81e0505..39ae34493 100644 --- a/Cslib/Foundations/Control/Monad/Free/Effects.lean +++ b/Cslib/Foundations/Control/Monad/Free/Effects.lean @@ -6,6 +6,7 @@ Authors: Tanner Duve import Mathlib.Control.Monad.Cont import Cslib.Foundations.Control.Monad.Free import Mathlib.Control.Monad.Writer +import Cslib.Foundations.Control.Monad.Time /-! # Free Monad @@ -14,7 +15,7 @@ This file defines several canonical instances on the free monad. ## Main definitions -- `FreeState`, `FreeWriter`, `FreeCont`: Specific effect monads +- `FreeState`, `FreeWriter`, `FreeTime`, `FreeCont`: Specific effect monads ## Implementation @@ -30,7 +31,7 @@ the universal property. ## Tags -Free monad, state monad, writer monad, continuation monad +Free monad, state monad, writer monad, time monad, continuation monad -/ namespace Cslib @@ -263,6 +264,39 @@ instance [Monoid ω] : MonadWriter ω (FreeWriter ω) where end FreeWriter +/-! ### Time Monad via `FreeM` -/ + +/-- Time monad implemented as the free writer monad over `Nat`. This models computations that +emit natural-number costs while producing a result. -/ +abbrev FreeTime := FreeWriter Nat + +namespace FreeTime + +variable {α : Type u} + +/-- Emit a time cost of `c` units (default `1`). -/ +def tick (c : Nat := 1) : FreeTime PUnit := + FreeWriter.tell c + +/-- Run a `FreeTime` computation, returning the result and total time cost. -/ +def run (comp : FreeTime α) : α × Nat := + FreeWriter.run (ω := Nat) comp + +/-- Interpret a `FreeTime` computation into the concrete time monad `TimeM`. -/ +def toTimeM (comp : FreeTime α) : TimeM α := + let (a, t) := run comp + ⟨a, t⟩ + +@[simp] +lemma run_pure (a : α) : + run (.pure a : FreeTime α) = (a, 1) := rfl + +@[simp] +lemma tick_def (c : Nat) : + tick c = (FreeWriter.tell c : FreeTime PUnit) := rfl + +end FreeTime + /-! ### Continuation Monad via `FreeM` -/ /-- Type constructor for continuation operations. -/ diff --git a/Cslib/Foundations/Control/Monad/Time.lean b/Cslib/Foundations/Control/Monad/Time.lean new file mode 100644 index 000000000..ca2edb1be --- /dev/null +++ b/Cslib/Foundations/Control/Monad/Time.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2025 Tanner Duve. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tanner Duve +-/ + +import Mathlib.Control.Monad.Writer + +/-! +# Time monad + +This file defines a simple monad `TimeM` that pairs a value with a natural number +representing an accumulated time/cost. As plain types it is isomorphic to `Writer Nat`. + +## Main definitions + +- `TimeM` : computations with a time component +- `TimeM.equivWriter` : equivalence with `Writer Nat` +-/ + +namespace Cslib + +universe u + +/-- A computation that returns a value of type `α` together with an accumulated +time cost (a natural number). -/ +structure TimeM (α : Type u) where + /-- The result of the computation. -/ + val : α + /-- The accumulated time cost. -/ + time : Nat + +namespace TimeM + +variable {α β : Type u} + +/-- Return a value with zero time cost. -/ +def pure (a : α) : TimeM α := + ⟨a, 0⟩ + +/-- Sequence two computations, adding their time components. -/ +def bind (m : TimeM α) (f : α → TimeM β) : TimeM β := + let r := f m.val + ⟨r.val, m.time + r.time⟩ + +instance : Monad TimeM where + pure := pure + bind := bind + +/-- Construct a value that costs `c` units of time. -/ +def tick (a : α) (c : Nat := 1) : TimeM α := + ⟨a, c⟩ + +@[simp] theorem time_of_pure (a : α) : (pure a).time = 0 := rfl + +@[simp] theorem time_of_bind (m : TimeM α) (f : α → TimeM β) : + (bind m f).time = m.time + (f m.val).time := rfl + +@[simp] theorem time_of_tick (a : α) (c : Nat) : (tick a c).time = c := rfl + +@[simp] theorem val_bind (m : TimeM α) (f : α → TimeM β) : + (bind m f).val = (f m.val).val := rfl + +/-- `TimeM` is (definitionally) the same as the writer monad `Writer Nat`. -/ +abbrev WriterNat (α : Type) := WriterT Nat Id α + +/-- Equivalence between `TimeM α` and `Writer Nat α` as plain types. -/ +def equivWriter (α : Type) : TimeM α ≃ WriterNat α where + toFun m := (m.val, m.time) + invFun w := ⟨w.1, w.2⟩ + left_inv m := by cases m; rfl + right_inv w := by cases w; rfl + +@[simp] lemma equivWriter_toFun {α : Type} (m : TimeM α) : + (equivWriter α m : WriterNat α) = (m.val, m.time) := rfl + +@[simp] lemma equivWriter_invFun {α : Type} (w : WriterNat α) : + (equivWriter α).invFun w = TimeM.mk w.1 w.2 := rfl + +end TimeM + +end Cslib From c0c342660586acd7f66be65b01a416e2130303f1 Mon Sep 17 00:00:00 2001 From: Tanner Duve Date: Fri, 5 Dec 2025 15:15:31 -0800 Subject: [PATCH 002/176] fix up docs --- Cslib/Algorithms/MergeSort/MergeSort.lean | 4 ++-- Cslib/Algorithms/QueryModel.lean | 12 +++++------- 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/Cslib/Algorithms/MergeSort/MergeSort.lean b/Cslib/Algorithms/MergeSort/MergeSort.lean index cee93ffaa..9dd84051d 100644 --- a/Cslib/Algorithms/MergeSort/MergeSort.lean +++ b/Cslib/Algorithms/MergeSort/MergeSort.lean @@ -48,7 +48,8 @@ def split (xs : List Nat) : List Nat × List Nat := | x :: y :: xs, accL, accR => go xs (x :: accL) (y :: accR) go xs [] [] -/-- Merge sort expressed as a program in the query model. -/ +/-- Merge sort expressed as a program in the query model. +TODO: Working version without partial -/ partial def mergeSort : List Nat → Prog (List Nat) | [] => pure [] | [x] => pure [x] @@ -63,4 +64,3 @@ partial def mergeSort : List Nat → Prog (List Nat) #eval timeProg (mergeSort [5,3,8,6,2,7,4,1]) end Cslib.Algorithms.MergeSort.QueryBased - diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index d89c55d59..c8ef4433c 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2025 Tanner Duve. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Tanner Duve, Sorrachai Yingchareonthawornhcai +Authors: Tanner Duve -/ import Cslib.Foundations.Control.Monad.Free.Effects @@ -9,10 +9,9 @@ import Cslib.Foundations.Control.Monad.Free.Fold import Cslib.Foundations.Control.Monad.Time /- -# Query model for comparison-based algorithms +# Query model -This file defines a simple query language for reading, writing, and comparing natural numbers, -modeled as a free monad over primitive query operations. +This file defines a simple query language modeled as a free monad over primitive query operations. We equip this language with a cost model (`TimeM`) that counts how many primitive queries are performed. An example algorithm (merge sort) is implemented in @@ -20,10 +19,9 @@ are performed. An example algorithm (merge sort) is implemented in ## Main definitions -- `QueryF` : functor of primitive query operations -- `Prog` : free monad of query programs +- `QueryF`, `Prog` : query language and programs - `timeOfQuery`, `timeInterp`, `timeProg` : cost model for programs -- `evalProg` : concrete execution semantics for programs +- `evalQuery`, `evalProg` : concrete execution semantics ## Tags From a5389ab2b3ab428a54d889be8caa3c11dc0ef152 Mon Sep 17 00:00:00 2001 From: Tanner Duve Date: Fri, 5 Dec 2025 15:16:06 -0800 Subject: [PATCH 003/176] docs --- Cslib/Foundations/Control/Monad/Time.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/Foundations/Control/Monad/Time.lean b/Cslib/Foundations/Control/Monad/Time.lean index ca2edb1be..d9d36995c 100644 --- a/Cslib/Foundations/Control/Monad/Time.lean +++ b/Cslib/Foundations/Control/Monad/Time.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2025 Tanner Duve. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Tanner Duve +Authors: Tanner Duve, Sorrachai Yingchareonthawornhcai -/ import Mathlib.Control.Monad.Writer From a32b00d3f9c5a93630b9f20dca34cbecd4dd95bd Mon Sep 17 00:00:00 2001 From: Tanner Duve Date: Fri, 5 Dec 2025 15:39:28 -0800 Subject: [PATCH 004/176] fix up --- Cslib/Algorithms/QueryModel.lean | 14 +++- .../Control/Monad/Free/Effects.lean | 2 +- Cslib/Foundations/Control/Monad/Time.lean | 69 ++++++++----------- 3 files changed, 42 insertions(+), 43 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index c8ef4433c..e242916b6 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -28,7 +28,9 @@ are performed. An example algorithm (merge sort) is implemented in query model, free monad, time complexity, merge sort -/ -open Cslib +namespace Cslib + +namespace Algorithms /-- Primitive queries on natural-number registers. -/ inductive QueryF : Type → Type where @@ -54,11 +56,13 @@ def cond {α} (b : Prog Bool) (t e : Prog α) : Prog α := /-- A counting loop from `0` to `n - 1`, sequencing the body. -/ def forLoop (n : Nat) (body : Nat → Prog PUnit) : Prog PUnit := - let rec go : Nat → Prog PUnit + go n +where + /-- Auxiliary recursive worker for `forLoop`. -/ + go : Nat → Prog PUnit | 0 => pure () | i + 1 => body i >>= fun _ => go i - go n end Prog @@ -94,3 +98,7 @@ def evalProg {α : Type} (p : Prog α) : α := (fun {ι} (op : QueryF ι) (k : ι → α) => k (evalQuery op)) p + +end Algorithms + +end Cslib diff --git a/Cslib/Foundations/Control/Monad/Free/Effects.lean b/Cslib/Foundations/Control/Monad/Free/Effects.lean index 39ae34493..ea56e221c 100644 --- a/Cslib/Foundations/Control/Monad/Free/Effects.lean +++ b/Cslib/Foundations/Control/Monad/Free/Effects.lean @@ -272,7 +272,7 @@ abbrev FreeTime := FreeWriter Nat namespace FreeTime -variable {α : Type u} +variable {α : Type} /-- Emit a time cost of `c` units (default `1`). -/ def tick (c : Nat := 1) : FreeTime PUnit := diff --git a/Cslib/Foundations/Control/Monad/Time.lean b/Cslib/Foundations/Control/Monad/Time.lean index d9d36995c..1fe8e0c4d 100644 --- a/Cslib/Foundations/Control/Monad/Time.lean +++ b/Cslib/Foundations/Control/Monad/Time.lean @@ -1,82 +1,73 @@ /- -Copyright (c) 2025 Tanner Duve. All rights reserved. +Copyright (c) 2025 Sorrachai Yingchareonthawornhcai. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Tanner Duve, Sorrachai Yingchareonthawornhcai +Authors: Sorrachai Yingchareonthawornhcai, Tanner Duve -/ import Mathlib.Control.Monad.Writer /-! -# Time monad +# Time Monad -This file defines a simple monad `TimeM` that pairs a value with a natural number -representing an accumulated time/cost. As plain types it is isomorphic to `Writer Nat`. - -## Main definitions - -- `TimeM` : computations with a time component -- `TimeM.equivWriter` : equivalence with `Writer Nat` +`TimeM` is a monad that tracks execution time alongside computations, using natural numbers +as a simple cost model. As plain types it is isomorphic to `WriterT Nat Id`. -/ -namespace Cslib - -universe u +set_option tactic.hygienic false +set_option autoImplicit false -/-- A computation that returns a value of type `α` together with an accumulated -time cost (a natural number). -/ -structure TimeM (α : Type u) where +structure TimeM (α : Type) where /-- The result of the computation. -/ - val : α + ret : α /-- The accumulated time cost. -/ time : Nat namespace TimeM -variable {α β : Type u} - -/-- Return a value with zero time cost. -/ -def pure (a : α) : TimeM α := +def pure {α} (a : α) : TimeM α := ⟨a, 0⟩ -/-- Sequence two computations, adding their time components. -/ -def bind (m : TimeM α) (f : α → TimeM β) : TimeM β := - let r := f m.val - ⟨r.val, m.time + r.time⟩ +def bind {α β} (m : TimeM α) (f : α → TimeM β) : TimeM β := + let r := f m.ret + ⟨r.ret, m.time + r.time⟩ instance : Monad TimeM where pure := pure bind := bind -/-- Construct a value that costs `c` units of time. -/ -def tick (a : α) (c : Nat := 1) : TimeM α := +@[simp] def tick {α : Type} (a : α) (c : ℕ := 1) : TimeM α := ⟨a, c⟩ -@[simp] theorem time_of_pure (a : α) : (pure a).time = 0 := rfl +scoped notation "✓" a:arg ", " c:arg => tick a c +scoped notation "✓" a:arg => tick a -- Default case with only one argument -@[simp] theorem time_of_bind (m : TimeM α) (f : α → TimeM β) : - (bind m f).time = m.time + (f m.val).time := rfl +def tickUnit : TimeM Unit := + ✓ () -- This uses the default time increment of 1 -@[simp] theorem time_of_tick (a : α) (c : Nat) : (tick a c).time = c := rfl +@[simp] theorem time_of_pure {α} (a : α) : (pure a).time = 0 := rfl +@[simp] theorem time_of_bind {α β} (m : TimeM α) (f : α → TimeM β) : + (TimeM.bind m f).time = m.time + (f m.ret).time := rfl +@[simp] theorem time_of_tick {α} (a : α) (c : ℕ) : (tick a c).time = c := rfl +@[simp] theorem ret_bind {α β} (m : TimeM α) (f : α → TimeM β) : + (TimeM.bind m f).ret = (f m.ret).ret := rfl -@[simp] theorem val_bind (m : TimeM α) (f : α → TimeM β) : - (bind m f).val = (f m.val).val := rfl +-- this allow us to simplify the chain of compositions +attribute [simp] Bind.bind Pure.pure TimeM.pure -/-- `TimeM` is (definitionally) the same as the writer monad `Writer Nat`. -/ +/-- `TimeM` is (definitionally) the same as the writer monad `WriterT Nat Id`. -/ abbrev WriterNat (α : Type) := WriterT Nat Id α -/-- Equivalence between `TimeM α` and `Writer Nat α` as plain types. -/ +/-- Equivalence between `TimeM α` and `WriterT Nat Id α` as plain types. -/ def equivWriter (α : Type) : TimeM α ≃ WriterNat α where - toFun m := (m.val, m.time) + toFun m := (m.ret, m.time) invFun w := ⟨w.1, w.2⟩ left_inv m := by cases m; rfl right_inv w := by cases w; rfl @[simp] lemma equivWriter_toFun {α : Type} (m : TimeM α) : - (equivWriter α m : WriterNat α) = (m.val, m.time) := rfl + (equivWriter α m : WriterNat α) = (m.ret, m.time) := rfl @[simp] lemma equivWriter_invFun {α : Type} (w : WriterNat α) : (equivWriter α).invFun w = TimeM.mk w.1 w.2 := rfl end TimeM - -end Cslib From c8d3206965a25a076e2d2725206a96337b55ebf9 Mon Sep 17 00:00:00 2001 From: Tanner Duve Date: Fri, 5 Dec 2025 15:49:27 -0800 Subject: [PATCH 005/176] effects fix --- Cslib/Foundations/Control/Monad/Free/Effects.lean | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/Cslib/Foundations/Control/Monad/Free/Effects.lean b/Cslib/Foundations/Control/Monad/Free/Effects.lean index 9b6ea47bd..63bda5551 100644 --- a/Cslib/Foundations/Control/Monad/Free/Effects.lean +++ b/Cslib/Foundations/Control/Monad/Free/Effects.lean @@ -7,6 +7,7 @@ import Cslib.Foundations.Control.Monad.Free import Mathlib.Control.Monad.Writer import Cslib.Foundations.Control.Monad.Time import Mathlib.Control.Monad.Cont +import Mathlib.Data.Nat.Basic /-! # Free Monad @@ -278,9 +279,14 @@ variable {α : Type} def tick (c : Nat := 1) : FreeTime PUnit := FreeWriter.tell c -/-- Run a `FreeTime` computation, returning the result and total time cost. -/ -def run (comp : FreeTime α) : α × Nat := - FreeWriter.run (ω := Nat) comp +/-- Run a `FreeTime` computation, returning the result and total time cost. + +The cost is accumulated additively starting from `0`. -/ +def run : FreeTime α → α × Nat + | .pure a => (a, 0) + | .liftBind (.tell c) k => + let (a, t) := run (k .unit) + (a, c + t) /-- Interpret a `FreeTime` computation into the concrete time monad `TimeM`. -/ def toTimeM (comp : FreeTime α) : TimeM α := @@ -289,7 +295,7 @@ def toTimeM (comp : FreeTime α) : TimeM α := @[simp] lemma run_pure (a : α) : - run (.pure a : FreeTime α) = (a, 1) := rfl + run (.pure a : FreeTime α) = (a, 0) := rfl @[simp] lemma tick_def (c : Nat) : From 9c3c26cb73cd26762516d6721a696d720e429601 Mon Sep 17 00:00:00 2001 From: Tanner Duve Date: Fri, 5 Dec 2025 15:50:20 -0800 Subject: [PATCH 006/176] Add TimeM time/cost monad Co-authored-by: Sorrachai Yingchareonthawornhcai --- Cslib/Foundations/Control/Monad/Time.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Cslib/Foundations/Control/Monad/Time.lean b/Cslib/Foundations/Control/Monad/Time.lean index 1fe8e0c4d..51fa7245f 100644 --- a/Cslib/Foundations/Control/Monad/Time.lean +++ b/Cslib/Foundations/Control/Monad/Time.lean @@ -13,8 +13,8 @@ import Mathlib.Control.Monad.Writer as a simple cost model. As plain types it is isomorphic to `WriterT Nat Id`. -/ -set_option tactic.hygienic false -set_option autoImplicit false + + structure TimeM (α : Type) where /-- The result of the computation. -/ From 2136afe1679aadc2f51acb0a94de3cc3ececb614 Mon Sep 17 00:00:00 2001 From: Tanner Duve Date: Fri, 5 Dec 2025 15:52:58 -0800 Subject: [PATCH 007/176] Add TimeM time/cost monad Co-authored-by: Sorrachai Yingchareonthawornhcai --- Cslib/Foundations/Control/Monad/Time.lean | 3 - Cslib/Foundations/Control/Monad/TimeM.lean | 70 ++++++++++++++++++++++ 2 files changed, 70 insertions(+), 3 deletions(-) create mode 100644 Cslib/Foundations/Control/Monad/TimeM.lean diff --git a/Cslib/Foundations/Control/Monad/Time.lean b/Cslib/Foundations/Control/Monad/Time.lean index 51fa7245f..72ed077c5 100644 --- a/Cslib/Foundations/Control/Monad/Time.lean +++ b/Cslib/Foundations/Control/Monad/Time.lean @@ -13,9 +13,6 @@ import Mathlib.Control.Monad.Writer as a simple cost model. As plain types it is isomorphic to `WriterT Nat Id`. -/ - - - structure TimeM (α : Type) where /-- The result of the computation. -/ ret : α diff --git a/Cslib/Foundations/Control/Monad/TimeM.lean b/Cslib/Foundations/Control/Monad/TimeM.lean new file mode 100644 index 000000000..72ed077c5 --- /dev/null +++ b/Cslib/Foundations/Control/Monad/TimeM.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2025 Sorrachai Yingchareonthawornhcai. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sorrachai Yingchareonthawornhcai, Tanner Duve +-/ + +import Mathlib.Control.Monad.Writer + +/-! +# Time Monad + +`TimeM` is a monad that tracks execution time alongside computations, using natural numbers +as a simple cost model. As plain types it is isomorphic to `WriterT Nat Id`. +-/ + +structure TimeM (α : Type) where + /-- The result of the computation. -/ + ret : α + /-- The accumulated time cost. -/ + time : Nat + +namespace TimeM + +def pure {α} (a : α) : TimeM α := + ⟨a, 0⟩ + +def bind {α β} (m : TimeM α) (f : α → TimeM β) : TimeM β := + let r := f m.ret + ⟨r.ret, m.time + r.time⟩ + +instance : Monad TimeM where + pure := pure + bind := bind + +@[simp] def tick {α : Type} (a : α) (c : ℕ := 1) : TimeM α := + ⟨a, c⟩ + +scoped notation "✓" a:arg ", " c:arg => tick a c +scoped notation "✓" a:arg => tick a -- Default case with only one argument + +def tickUnit : TimeM Unit := + ✓ () -- This uses the default time increment of 1 + +@[simp] theorem time_of_pure {α} (a : α) : (pure a).time = 0 := rfl +@[simp] theorem time_of_bind {α β} (m : TimeM α) (f : α → TimeM β) : + (TimeM.bind m f).time = m.time + (f m.ret).time := rfl +@[simp] theorem time_of_tick {α} (a : α) (c : ℕ) : (tick a c).time = c := rfl +@[simp] theorem ret_bind {α β} (m : TimeM α) (f : α → TimeM β) : + (TimeM.bind m f).ret = (f m.ret).ret := rfl + +-- this allow us to simplify the chain of compositions +attribute [simp] Bind.bind Pure.pure TimeM.pure + +/-- `TimeM` is (definitionally) the same as the writer monad `WriterT Nat Id`. -/ +abbrev WriterNat (α : Type) := WriterT Nat Id α + +/-- Equivalence between `TimeM α` and `WriterT Nat Id α` as plain types. -/ +def equivWriter (α : Type) : TimeM α ≃ WriterNat α where + toFun m := (m.ret, m.time) + invFun w := ⟨w.1, w.2⟩ + left_inv m := by cases m; rfl + right_inv w := by cases w; rfl + +@[simp] lemma equivWriter_toFun {α : Type} (m : TimeM α) : + (equivWriter α m : WriterNat α) = (m.ret, m.time) := rfl + +@[simp] lemma equivWriter_invFun {α : Type} (w : WriterNat α) : + (equivWriter α).invFun w = TimeM.mk w.1 w.2 := rfl + +end TimeM From f5397b060857292a5fd9a833a4558578d0846484 Mon Sep 17 00:00:00 2001 From: Tanner Duve Date: Fri, 5 Dec 2025 15:53:13 -0800 Subject: [PATCH 008/176] rename --- Cslib/Foundations/Control/Monad/TimeM.lean | 70 ---------------------- 1 file changed, 70 deletions(-) delete mode 100644 Cslib/Foundations/Control/Monad/TimeM.lean diff --git a/Cslib/Foundations/Control/Monad/TimeM.lean b/Cslib/Foundations/Control/Monad/TimeM.lean deleted file mode 100644 index 72ed077c5..000000000 --- a/Cslib/Foundations/Control/Monad/TimeM.lean +++ /dev/null @@ -1,70 +0,0 @@ -/- -Copyright (c) 2025 Sorrachai Yingchareonthawornhcai. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Sorrachai Yingchareonthawornhcai, Tanner Duve --/ - -import Mathlib.Control.Monad.Writer - -/-! -# Time Monad - -`TimeM` is a monad that tracks execution time alongside computations, using natural numbers -as a simple cost model. As plain types it is isomorphic to `WriterT Nat Id`. --/ - -structure TimeM (α : Type) where - /-- The result of the computation. -/ - ret : α - /-- The accumulated time cost. -/ - time : Nat - -namespace TimeM - -def pure {α} (a : α) : TimeM α := - ⟨a, 0⟩ - -def bind {α β} (m : TimeM α) (f : α → TimeM β) : TimeM β := - let r := f m.ret - ⟨r.ret, m.time + r.time⟩ - -instance : Monad TimeM where - pure := pure - bind := bind - -@[simp] def tick {α : Type} (a : α) (c : ℕ := 1) : TimeM α := - ⟨a, c⟩ - -scoped notation "✓" a:arg ", " c:arg => tick a c -scoped notation "✓" a:arg => tick a -- Default case with only one argument - -def tickUnit : TimeM Unit := - ✓ () -- This uses the default time increment of 1 - -@[simp] theorem time_of_pure {α} (a : α) : (pure a).time = 0 := rfl -@[simp] theorem time_of_bind {α β} (m : TimeM α) (f : α → TimeM β) : - (TimeM.bind m f).time = m.time + (f m.ret).time := rfl -@[simp] theorem time_of_tick {α} (a : α) (c : ℕ) : (tick a c).time = c := rfl -@[simp] theorem ret_bind {α β} (m : TimeM α) (f : α → TimeM β) : - (TimeM.bind m f).ret = (f m.ret).ret := rfl - --- this allow us to simplify the chain of compositions -attribute [simp] Bind.bind Pure.pure TimeM.pure - -/-- `TimeM` is (definitionally) the same as the writer monad `WriterT Nat Id`. -/ -abbrev WriterNat (α : Type) := WriterT Nat Id α - -/-- Equivalence between `TimeM α` and `WriterT Nat Id α` as plain types. -/ -def equivWriter (α : Type) : TimeM α ≃ WriterNat α where - toFun m := (m.ret, m.time) - invFun w := ⟨w.1, w.2⟩ - left_inv m := by cases m; rfl - right_inv w := by cases w; rfl - -@[simp] lemma equivWriter_toFun {α : Type} (m : TimeM α) : - (equivWriter α m : WriterNat α) = (m.ret, m.time) := rfl - -@[simp] lemma equivWriter_invFun {α : Type} (w : WriterNat α) : - (equivWriter α).invFun w = TimeM.mk w.1 w.2 := rfl - -end TimeM From 9e6fcd4114fe189947fea09d1939ab61ed7f5862 Mon Sep 17 00:00:00 2001 From: Tanner Duve Date: Fri, 5 Dec 2025 15:58:35 -0800 Subject: [PATCH 009/176] update cslib.lean --- Cslib.lean | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Cslib.lean b/Cslib.lean index 17891097e..e7ae752ee 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,3 +1,5 @@ +import Cslib.Algorithms.MergeSort.MergeSort +import Cslib.Algorithms.QueryModel import Cslib.Computability.Automata.Acceptors.Acceptor import Cslib.Computability.Automata.Acceptors.OmegaAcceptor import Cslib.Computability.Automata.DA.Basic @@ -21,6 +23,7 @@ import Cslib.Computability.Languages.RegularLanguage import Cslib.Foundations.Control.Monad.Free import Cslib.Foundations.Control.Monad.Free.Effects import Cslib.Foundations.Control.Monad.Free.Fold +import Cslib.Foundations.Control.Monad.Time import Cslib.Foundations.Data.FinFun import Cslib.Foundations.Data.HasFresh import Cslib.Foundations.Data.Nat.Segment From 9381b9aab11a148c73313efbd2bcf3c332c61c5b Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 6 Dec 2025 01:36:12 +0100 Subject: [PATCH 010/176] Test PR to PR ability with doc comment --- Cslib/Algorithms/QueryModel.lean | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index e242916b6..ec0a57266 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -11,7 +11,8 @@ import Cslib.Foundations.Control.Monad.Time /- # Query model -This file defines a simple query language modeled as a free monad over primitive query operations. +This file defines a simple query language modeled as a free monad over a +parametric type of query operations. We equip this language with a cost model (`TimeM`) that counts how many primitive queries are performed. An example algorithm (merge sort) is implemented in From aeed9a74db5c974f18dcfe916fbef92f47b5a0e2 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 6 Dec 2025 02:42:36 +0100 Subject: [PATCH 011/176] Yet to fix monad instance issue in timeProg function --- Cslib/Algorithms/MergeSort/MergeSort.lean | 33 ++++++++++- Cslib/Algorithms/QueryModel.lean | 69 +++++++++++------------ 2 files changed, 64 insertions(+), 38 deletions(-) diff --git a/Cslib/Algorithms/MergeSort/MergeSort.lean b/Cslib/Algorithms/MergeSort/MergeSort.lean index 9dd84051d..222619fb0 100644 --- a/Cslib/Algorithms/MergeSort/MergeSort.lean +++ b/Cslib/Algorithms/MergeSort/MergeSort.lean @@ -27,8 +27,37 @@ namespace Cslib.Algorithms.MergeSort.QueryBased open Cslib.Algorithms + +/-- The Model for comparison sorting natural-number registers.-/ +inductive QueryF : Type → Type where + /-- Read the value stored at index `i`. -/ + | read : Nat → QueryF Nat + /-- Write value `v` at index `i`. -/ + | write : Nat → Nat → QueryF PUnit + /-- Compare the values at indices `i` and `j`. -/ + | cmp : Nat → Nat → QueryF Bool + +/-- Lift a comparison into the query language at the top level. -/ +def cmpVal (x y : Nat) : Prog Bool := + FreeM.lift (QueryF.cmp x y) + +/-- Concrete semantics for primitive queries, used to run programs. -/ +def evalQuery : {ι : Type} → QueryF ι → ι + | _, .read _ => 0 + | _, .write _ _ => PUnit.unit + | _, .cmp x y => x ≤ y + + + + +abbrev SortProg := Prog QueryF + +/-- Lift a comparison on values into the free monad. -/ +def cmpVal (x y : Nat) : SortProg Bool := + FreeM.lift (QueryF.cmp x y) + /-- Merge two sorted lists using comparisons in the query monad. -/ -def merge : List Nat → List Nat → Prog (List Nat) +def merge : List Nat → List Nat → SortProg (List Nat) | [], ys => pure ys | xs, [] => pure xs | x :: xs', y :: ys' => do @@ -50,7 +79,7 @@ def split (xs : List Nat) : List Nat × List Nat := /-- Merge sort expressed as a program in the query model. TODO: Working version without partial -/ -partial def mergeSort : List Nat → Prog (List Nat) +partial def mergeSort : List Nat → SortProg (List Nat) | [] => pure [] | [x] => pure [x] | xs => diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index ec0a57266..4b604e93b 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -33,70 +33,67 @@ namespace Cslib namespace Algorithms -/-- Primitive queries on natural-number registers. -/ -inductive QueryF : Type → Type where - /-- Read the value stored at index `i`. -/ - | read : Nat → QueryF Nat - /-- Write value `v` at index `i`. -/ - | write : Nat → Nat → QueryF PUnit - /-- Compare the values at indices `i` and `j`. -/ - | cmp : Nat → Nat → QueryF Bool + /-- Programs built as the free monad over `QueryF`. -/ -abbrev Prog (α : Type) := FreeM QueryF α +abbrev Prog (QType : Type u → Type u) (α : Type v) := FreeM QType α + +instance {QType : Type u → Type u} : Bind (Prog QType) := inferInstance +instance {QType : Type u → Type u} : Monad (Prog QType) := inferInstance namespace Prog -/-- Lift a comparison on values into the free monad. -/ -def cmpVal (x y : Nat) : Prog Bool := - FreeM.lift (QueryF.cmp x y) + /-- Conditional branching on a boolean program. -/ -def cond {α} (b : Prog Bool) (t e : Prog α) : Prog α := +def cond {QType} {α} (b : Prog QType Bool) (t e : Prog QType α) : Prog QType α := b.bind (fun b' => if b' then t else e) /-- A counting loop from `0` to `n - 1`, sequencing the body. -/ -def forLoop (n : Nat) (body : Nat → Prog PUnit) : Prog PUnit := +def forLoop {QType} (n : Nat) (body : Nat → Prog QType PUnit) : Prog QType PUnit := go n where /-- Auxiliary recursive worker for `forLoop`. -/ - go : Nat → Prog PUnit + go : Nat → Prog QType PUnit | 0 => pure () | i + 1 => body i >>= fun _ => go i end Prog -/-- Constant time cost assigned to each primitive query. -/ -def timeOfQuery : {ι : Type} → QueryF ι → Nat - | _, .read _ => 1 - | _, .write _ _ => 1 - | _, .cmp _ _ => 1 +class Query (Q : Type u → Type u) where + timeOfQuery : {ι : Type u} → Q ι → Nat + evalQuery : {ι : Type u} → Q ι → ι + +open Query +-- /-- Constant time cost assigned to each primitive query. -/ +-- def timeOfQuery : {ι : Type} → QueryF ι → Nat +-- | _, .read _ => 1 +-- | _, .write _ _ => 1 +-- | _, .cmp _ _ => 1 + +/-- +Interpret primitive queries into the time-counting monad `TimeM`. +-/ +def timeInterp [Query QF] {ι : Type u} (q : QF ι) : Nat := + Query.timeOfQuery q -/-- Interpret primitive queries into the time-counting monad `TimeM`. -/ -def timeInterp : {ι : Type} → QueryF ι → TimeM ι - | _, .read i => TimeM.tick 0 (timeOfQuery (.read i)) - | _, .write i v => TimeM.tick PUnit.unit (timeOfQuery (.write i v)) - | _, .cmp i j => TimeM.tick false (timeOfQuery (.cmp i j)) +-- /-- Interpret primitive queries into the time-counting monad `TimeM`. -/ +-- def timeInterp : {ι : Type} → QueryF ι → TimeM ι +-- | _, .read i => TimeM.tick 0 (timeOfQuery (.read i)) +-- | _, .write i v => TimeM.tick PUnit.unit (timeOfQuery (.write i v)) +-- | _, .cmp i j => TimeM.tick false (timeOfQuery (.cmp i j)) /-- Total time cost of running a program under the interpreter `timeInterp`. -/ -def timeProg {α : Type} (p : Prog α) : Nat := +def timeProg [Query QF] {α : Type u} (p : Prog QF α) : Nat := (p.liftM timeInterp).time -/-- Lift a comparison into the query language at the top level. -/ -def cmpVal (x y : Nat) : Prog Bool := - FreeM.lift (QueryF.cmp x y) -/-- Concrete semantics for primitive queries, used to run programs. -/ -def evalQuery : {ι : Type} → QueryF ι → ι - | _, .read _ => 0 - | _, .write _ _ => PUnit.unit - | _, .cmp x y => x ≤ y /-- Evaluate a query program to a pure value using `evalQuery`. -/ -def evalProg {α : Type} (p : Prog α) : α := +def evalProg [Query QF] {α : Type} (p : Prog QF α) : α := FreeM.foldFreeM id - (fun {ι} (op : QueryF ι) (k : ι → α) => + (fun {ι} (op : QF ι) (k : ι → α) => k (evalQuery op)) p From b8c9a1efcb45a274236a4d0b32467797d7a9b8c5 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 6 Dec 2025 02:44:12 +0100 Subject: [PATCH 012/176] Remove unnecessary instance --- Cslib/Algorithms/QueryModel.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 4b604e93b..9ee2f7178 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -38,7 +38,6 @@ namespace Algorithms /-- Programs built as the free monad over `QueryF`. -/ abbrev Prog (QType : Type u → Type u) (α : Type v) := FreeM QType α -instance {QType : Type u → Type u} : Bind (Prog QType) := inferInstance instance {QType : Type u → Type u} : Monad (Prog QType) := inferInstance namespace Prog @@ -84,6 +83,7 @@ def timeInterp [Query QF] {ι : Type u} (q : QF ι) : Nat := -- | _, .write i v => TimeM.tick PUnit.unit (timeOfQuery (.write i v)) -- | _, .cmp i j => TimeM.tick false (timeOfQuery (.cmp i j)) +set_option diagnostics true /-- Total time cost of running a program under the interpreter `timeInterp`. -/ def timeProg [Query QF] {α : Type u} (p : Prog QF α) : Nat := (p.liftM timeInterp).time From 9f1ba8ac5a0bb04153c2e736e9979b45c525fcce Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 6 Dec 2025 03:05:40 +0100 Subject: [PATCH 013/176] monadLift instance needed --- Cslib/Algorithms/QueryModel.lean | 14 +++++++++++--- Cslib/Foundations/Control/Monad/Time.lean | 2 +- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 9ee2f7178..5a769901d 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -40,6 +40,10 @@ abbrev Prog (QType : Type u → Type u) (α : Type v) := FreeM QType α instance {QType : Type u → Type u} : Monad (Prog QType) := inferInstance + + + + namespace Prog @@ -74,8 +78,8 @@ open Query /-- Interpret primitive queries into the time-counting monad `TimeM`. -/ -def timeInterp [Query QF] {ι : Type u} (q : QF ι) : Nat := - Query.timeOfQuery q +def timeInterp [Query QF] [Inhabited ι] (q : QF ι) : TimeM ι := + TimeM.tick default (timeOfQuery q) -- /-- Interpret primitive queries into the time-counting monad `TimeM`. -/ -- def timeInterp : {ι : Type} → QueryF ι → TimeM ι @@ -83,7 +87,11 @@ def timeInterp [Query QF] {ι : Type u} (q : QF ι) : Nat := -- | _, .write i v => TimeM.tick PUnit.unit (timeOfQuery (.write i v)) -- | _, .cmp i j => TimeM.tick false (timeOfQuery (.cmp i j)) -set_option diagnostics true + +instance {α : Type u} {Q : Type u → Type u} [Query Q] : MonadLiftT (Prog Q) TimeM where + monadLift (p : Prog Q α) : TimeM α := + timeInterp + /-- Total time cost of running a program under the interpreter `timeInterp`. -/ def timeProg [Query QF] {α : Type u} (p : Prog QF α) : Nat := (p.liftM timeInterp).time diff --git a/Cslib/Foundations/Control/Monad/Time.lean b/Cslib/Foundations/Control/Monad/Time.lean index 72ed077c5..41bce8f5c 100644 --- a/Cslib/Foundations/Control/Monad/Time.lean +++ b/Cslib/Foundations/Control/Monad/Time.lean @@ -13,7 +13,7 @@ import Mathlib.Control.Monad.Writer as a simple cost model. As plain types it is isomorphic to `WriterT Nat Id`. -/ -structure TimeM (α : Type) where +structure TimeM (α : Type u) where /-- The result of the computation. -/ ret : α /-- The accumulated time cost. -/ From 5e1eb09ab80ce6aca6ea3cf26ac60ba5a870a90d Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 20 Jan 2026 14:53:05 +0100 Subject: [PATCH 014/176] Need to restart --- Cslib.lean | 4 +- Cslib/Algorithms/QueryModel.lean | 115 ++++++++++-------- .../Control/Monad/Free/Effects.lean | 6 +- Cslib/Foundations/Control/Monad/Time.lean | 7 +- 4 files changed, 71 insertions(+), 61 deletions(-) diff --git a/Cslib.lean b/Cslib.lean index 0a4bc085a..419d2e3a1 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,8 +1,8 @@ module public import Cslib.Algorithms.MergeSort.MergeSort -import Cslib.Algorithms.QueryModel -import Cslib.Algorithms.Lean.MergeSort.MergeSort +public import Cslib.Algorithms.QueryModel +public import Cslib.Algorithms.Lean.MergeSort.MergeSort 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/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 5a769901d..70138a682 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -4,9 +4,12 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Tanner Duve -/ -import Cslib.Foundations.Control.Monad.Free.Effects -import Cslib.Foundations.Control.Monad.Free.Fold -import Cslib.Foundations.Control.Monad.Time +module + +public import Mathlib +public import Cslib.Foundations.Control.Monad.Free.Effects +public import Cslib.Foundations.Control.Monad.Free.Fold +public import Cslib.Foundations.Control.Monad.Time /- # Query model @@ -33,77 +36,81 @@ namespace Cslib namespace Algorithms +structure Model (QType : Type u → Type u) (ι o : Type u) where + evalQuery : QType ι → ι → o + cost : QType ι → ι → ℕ +namespace Model -/-- Programs built as the free monad over `QueryF`. -/ -abbrev Prog (QType : Type u → Type u) (α : Type v) := FreeM QType α - +def interpretTimeM + (M : Model Q α β) (q : Q α) (inp : α) : TimeM β where + ret := M.evalQuery q inp + time := M.cost q inp -instance {QType : Type u → Type u} : Monad (Prog QType) := inferInstance +section Examples +inductive Search (α : Type*) where + | find (elem : α) (list : List α) +def LinSearch_WorstCase [DecidableEq α] : Model Search α ℕ where + evalQuery q := + match q with + | .find elem list => List.findIdx (· = elem) list -- sorry we need a more general type + cost q := + match q with + | .find _ list => list.length -namespace Prog +def BinSearch_WorstCase [BEq α] : Model Search α ℕ where + evalQuery q := + match q with + | .find elem list => List.findIdx (· == elem) list + cost q := + match q with + | .find _ l => 1 + Nat.log 2 l.length -/-- Conditional branching on a boolean program. -/ -def cond {QType} {α} (b : Prog QType Bool) (t e : Prog QType α) : Prog QType α := - b.bind (fun b' => if b' then t else e) +inductive Arith α where + | add (x y : α) + | mul (x y : α) + | neg (x : α) + | zero + | one -/-- A counting loop from `0` to `n - 1`, sequencing the body. -/ -def forLoop {QType} (n : Nat) (body : Nat → Prog QType PUnit) : Prog QType PUnit := - go n -where - /-- Auxiliary recursive worker for `forLoop`. -/ - go : Nat → Prog QType PUnit - | 0 => pure () - | i + 1 => - body i >>= fun _ => go i - -end Prog +noncomputable def RealArithQuery : Model Arith ℝ ℝ where + evalQuery q _ := + match q with + | .add x y => x + y + | .mul x y => x * y + | .neg x => -x + | .zero => (0 : ℝ) + | .one => (1 : ℝ) + cost _ := 1 -class Query (Q : Type u → Type u) where - timeOfQuery : {ι : Type u} → Q ι → Nat - evalQuery : {ι : Type u} → Q ι → ι +end Examples -open Query --- /-- Constant time cost assigned to each primitive query. -/ --- def timeOfQuery : {ι : Type} → QueryF ι → Nat --- | _, .read _ => 1 --- | _, .write _ _ => 1 --- | _, .cmp _ _ => 1 +/-- Programs built as the free ~~monad~~ arrow? over `QueryF`. -/ +inductive Prog (Q : Type u → Type v) : Type u → Type (max u v + 1) where + | pure (q : Q α) : Prog Q α + | seq (p₁ : Prog Q α) (cont : α → Prog Q β) : Prog Q β -/-- -Interpret primitive queries into the time-counting monad `TimeM`. --/ -def timeInterp [Query QF] [Inhabited ι] (q : QF ι) : TimeM ι := - TimeM.tick default (timeOfQuery q) - --- /-- Interpret primitive queries into the time-counting monad `TimeM`. -/ --- def timeInterp : {ι : Type} → QueryF ι → TimeM ι --- | _, .read i => TimeM.tick 0 (timeOfQuery (.read i)) --- | _, .write i v => TimeM.tick PUnit.unit (timeOfQuery (.write i v)) --- | _, .cmp i j => TimeM.tick false (timeOfQuery (.cmp i j)) +namespace Prog +-- This is a problem. Only works for a uniform family of models +def eval (P : Prog Q α β) (modelFamily : ∀ i o, Model Q i o) : α := + match P with + | .pure x => x + | @FreeM.liftBind Q α ι q continuation => + let qval := evalQuery (modelFamily ι) q + eval (continuation qval) modelFamily -instance {α : Type u} {Q : Type u → Type u} [Query Q] : MonadLiftT (Prog Q) TimeM where - monadLift (p : Prog Q α) : TimeM α := - timeInterp -/-- Total time cost of running a program under the interpreter `timeInterp`. -/ -def timeProg [Query QF] {α : Type u} (p : Prog QF α) : Nat := - (p.liftM timeInterp).time +end Prog -/-- Evaluate a query program to a pure value using `evalQuery`. -/ -def evalProg [Query QF] {α : Type} (p : Prog QF α) : α := - FreeM.foldFreeM id - (fun {ι} (op : QF ι) (k : ι → α) => - k (evalQuery op)) - p +end Model end Algorithms diff --git a/Cslib/Foundations/Control/Monad/Free/Effects.lean b/Cslib/Foundations/Control/Monad/Free/Effects.lean index 452efa12d..ab29e04e8 100644 --- a/Cslib/Foundations/Control/Monad/Free/Effects.lean +++ b/Cslib/Foundations/Control/Monad/Free/Effects.lean @@ -7,10 +7,10 @@ Authors: Tanner Duve module public import Cslib.Foundations.Control.Monad.Free -import Mathlib.Control.Monad.Writer -import Cslib.Foundations.Control.Monad.Time +public import Mathlib.Control.Monad.Writer +public import Cslib.Foundations.Control.Monad.Time public import Mathlib.Control.Monad.Cont -import Mathlib.Data.Nat.Basic +public import Mathlib.Data.Nat.Basic @[expose] public section diff --git a/Cslib/Foundations/Control/Monad/Time.lean b/Cslib/Foundations/Control/Monad/Time.lean index 41bce8f5c..a29fb2e3a 100644 --- a/Cslib/Foundations/Control/Monad/Time.lean +++ b/Cslib/Foundations/Control/Monad/Time.lean @@ -4,8 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Sorrachai Yingchareonthawornhcai, Tanner Duve -/ -import Mathlib.Control.Monad.Writer +module +public import Mathlib.Control.Monad.Writer + +@[expose] public section /-! # Time Monad @@ -28,7 +31,7 @@ def bind {α β} (m : TimeM α) (f : α → TimeM β) : TimeM β := let r := f m.ret ⟨r.ret, m.time + r.time⟩ -instance : Monad TimeM where +instance instMonadTimeM : Monad TimeM where pure := pure bind := bind From aaf1d8779f9c151684c3cd75f46c85607a168356 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 21 Jan 2026 17:58:22 +0100 Subject: [PATCH 015/176] Revert to FreeM, but use extra type param --- Cslib/Algorithms/QueryModel.lean | 116 ++++++++++++------ .../Control/Monad/Free/Effects.lean | 100 +++------------ 2 files changed, 97 insertions(+), 119 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 70138a682..3439973d1 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -9,7 +9,9 @@ module public import Mathlib public import Cslib.Foundations.Control.Monad.Free.Effects public import Cslib.Foundations.Control.Monad.Free.Fold -public import Cslib.Foundations.Control.Monad.Time + + +@[expose] public section /- # Query model @@ -24,7 +26,6 @@ are performed. An example algorithm (merge sort) is implemented in ## Main definitions - `QueryF`, `Prog` : query language and programs -- `timeOfQuery`, `timeInterp`, `timeProg` : cost model for programs - `evalQuery`, `evalProg` : concrete execution semantics ## Tags @@ -36,50 +37,87 @@ namespace Cslib namespace Algorithms -structure Model (QType : Type u → Type u) (ι o : Type u) where - evalQuery : QType ι → ι → o - cost : QType ι → ι → ℕ +class Model (QType : Type u → Type u) where + evalQuery : QType ι → ι + cost : QType ι → ℕ namespace Model def interpretTimeM - (M : Model Q α β) (q : Q α) (inp : α) : TimeM β where - ret := M.evalQuery q inp - time := M.cost q inp - + [M : Model Q] (q : Q ι) : TimeM ι where + ret := M.evalQuery q + time := M.cost q + +-- inductive QueryF : Type → Type where +-- /-- Read the value stored at index `i`. -/ +-- | read : Nat → QueryF Nat +-- /-- Write value `v` at index `i`. -/ +-- | write : Nat → Nat → QueryF PUnit +-- /-- Compare the values at indices `i` and `j`. -/ +-- | cmp : Nat → Nat → QueryF Bool section Examples -inductive Search (α : Type*) where - | find (elem : α) (list : List α) +inductive ListOps (α : Type) : Type → Type where + | get : (l : List α) → (i : Fin l.length) → ListOps α α + | find : (l : List α) → α → ListOps α ℕ + | write : (l : List α) → (i : Fin l.length) → (x : α) → ListOps α (List α) + -def LinSearch_WorstCase [DecidableEq α] : Model Search α ℕ where +instance List_LinSearch_WorstCase [DecidableEq α] : Model (ListOps α) where evalQuery q := match q with - | .find elem list => List.findIdx (· = elem) list -- sorry we need a more general type + | .write l i x => l.set i x + | .find l elem => l.findIdx (· = elem) + | .get l i => l[i] cost q := match q with - | .find _ list => list.length + | .write l i x => l.length + | .find l elem => l.length + | .get l i => l.length -def BinSearch_WorstCase [BEq α] : Model Search α ℕ where +def List_BinSearch_WorstCase [BEq α] : Model (ListOps α) where evalQuery q := match q with - | .find elem list => List.findIdx (· == elem) list + | .write l i x => l.set i x + | .get l i => l[i] + | .find l elem => l.findIdx (· == elem) + cost q := match q with - | .find _ l => 1 + Nat.log 2 l.length + | .find l _ => 1 + Nat.log 2 (l.length) + | .write l i x => l.length + | .get l x => l.length + +inductive ArrayOps (α : Type) : Type → Type where + | get : (l : Array α) → (i : Fin l.size) → ArrayOps α α + | find : (l : Array α) → α → ArrayOps α ℕ + | write : (l : Array α) → (i : Fin l.size) → (x : α) → ArrayOps α (Array α) -inductive Arith α where - | add (x y : α) - | mul (x y : α) - | neg (x : α) - | zero - | one +def Array_BinSearch_WorstCase [BEq α] : Model (ArrayOps α) where + evalQuery q := + match q with + | .write l i x => l.set i x + | .get l i => l[i] + | .find l elem => l.findIdx (· == elem) -noncomputable def RealArithQuery : Model Arith ℝ ℝ where - evalQuery q _ := + cost q := + match q with + | .find l _ => 1 + Nat.log 2 (l.size) + | .write l i x => 1 + | .get l x => 1 + +inductive Arith (α : Type) : Type → Type where + | add (x y : α) : Arith α α + | mul (x y : α) : Arith α α + | neg (x : α) : Arith α α + | zero : Arith α α + | one : Arith α α + +noncomputable def RealArithQuery : Model (Arith ℝ) where + evalQuery q := match q with | .add x y => x + y | .mul x y => x * y @@ -90,23 +128,29 @@ noncomputable def RealArithQuery : Model Arith ℝ ℝ where end Examples -/-- Programs built as the free ~~monad~~ arrow? over `QueryF`. -/ -inductive Prog (Q : Type u → Type v) : Type u → Type (max u v + 1) where - | pure (q : Q α) : Prog Q α - | seq (p₁ : Prog Q α) (cont : α → Prog Q β) : Prog Q β +-- ALternative def where pure has to be a query +-- /-- Programs built as the free ~~monad~~ arrow? over `QueryF`. -/ +-- inductive Prog (Q : Type u → Type u) : Type u → Type (u + 1) where +-- | pure (q : Q α) : Prog Q α +-- | seq (p₁ : Prog Q ι) (cont : ι → Prog Q α) : Prog Q α +abbrev Prog Q α := FreeM Q α namespace Prog --- This is a problem. Only works for a uniform family of models -def eval (P : Prog Q α β) (modelFamily : ∀ i o, Model Q i o) : α := +def eval (P : Prog Q α) (M : Model Q) : α := match P with | .pure x => x - | @FreeM.liftBind Q α ι q continuation => - let qval := evalQuery (modelFamily ι) q - eval (continuation qval) modelFamily - - + | .liftBind op cont => + let qval := M.evalQuery op + eval (cont qval) M +def time (P : Prog Q α) (M : Model Q) : Nat := + match P with + | .pure _ => 0 + | .liftBind op cont => + let t₁ := M.cost op + let qval := M.evalQuery op + t₁ + (time (cont qval) M) end Prog diff --git a/Cslib/Foundations/Control/Monad/Free/Effects.lean b/Cslib/Foundations/Control/Monad/Free/Effects.lean index 8d92dfab0..ab29e04e8 100644 --- a/Cslib/Foundations/Control/Monad/Free/Effects.lean +++ b/Cslib/Foundations/Control/Monad/Free/Effects.lean @@ -9,8 +9,8 @@ module public import Cslib.Foundations.Control.Monad.Free public import Mathlib.Control.Monad.Writer public import Cslib.Foundations.Control.Monad.Time -public import Mathlib.Algebra.Group.Hom.Defs public import Mathlib.Control.Monad.Cont +public import Mathlib.Data.Nat.Basic @[expose] public section @@ -21,16 +21,14 @@ This file defines several canonical instances on the free monad. ## Main definitions -- `FreeState`, `FreeWriter`, `FreeCont`: Specific effect monads +- `FreeState`, `FreeWriter`, `FreeTime`, `FreeCont`: Specific effect monads ## Implementation To execute or interpret these computations, we provide two approaches: -1. **Hand-written interpreters** (`FreeState.run`, `FreeWriter.run`, `FreeCont.run`, - `FreeReader.run`) that directly +1. **Hand-written interpreters** (`FreeState.run`, `FreeWriter.run`, `FreeCont.run`) that directly pattern-match on the tree structure -2. **Canonical interpreters** (`FreeState.toStateM`, `FreeWriter.toWriterT`, `FreeCont.toContT`, - `FreeReader.toReaderM`) +2. **Canonical interpreters** (`FreeState.toStateM`, `FreeWriter.toWriterT`, `FreeCont.toContT`) derived from the universal property via `liftM` We prove that these approaches are equivalent, demonstrating that the implementation aligns with @@ -63,6 +61,9 @@ abbrev FreeState (σ : Type u) := FreeM (StateF σ) namespace FreeState variable {σ : Type u} {α : Type v} +instance : Monad (FreeState σ) := inferInstance +instance : LawfulMonad (FreeState σ) := inferInstance + instance : MonadStateOf σ (FreeState σ) where get := .lift .get set newState := .liftBind (.set newState) (fun _ => .pure PUnit.unit) @@ -77,6 +78,8 @@ lemma get_def : (get : FreeState σ σ) = .lift .get := rfl @[simp] lemma set_def (s : σ) : (set s : FreeState σ PUnit) = .lift (.set s) := rfl +instance : MonadState σ (FreeState σ) := inferInstance + /-- Interpret `StateF` operations into `StateM`. -/ def stateInterp {α : Type u} : StateF σ α → StateM σ α | .get => MonadStateOf.get @@ -164,7 +167,10 @@ abbrev FreeWriter (ω : Type u) := FreeM (WriterF ω) namespace FreeWriter open WriterF -variable {ω : Type u} {α : Type u} +variable {ω : Type u} {α : Type v} + +instance : Monad (FreeWriter ω) := inferInstance +instance : LawfulMonad (FreeWriter ω) := inferInstance /-- Interpret `WriterF` operations into `WriterT`. -/ def writerInterp {α : Type u} : WriterF ω α → WriterT ω Id α @@ -319,9 +325,12 @@ abbrev FreeCont (r : Type u) := FreeM (ContF r) namespace FreeCont variable {r : Type u} {α : Type v} {β : Type w} +instance : Monad (FreeCont r) := inferInstance +instance : LawfulMonad (FreeCont r) := inferInstance + /-- Interpret `ContF r` operations into `ContT r Id`. -/ def contInterp : ContF r α → ContT r Id α - | .callCC g => g + | .callCC g, k => pure (g fun a => (k a).run) /-- Convert a `FreeCont` computation into a `ContT` computation. This is the canonical interpreter derived from `liftM`. -/ @@ -385,81 +394,6 @@ lemma run_callCC (f : MonadCont.Label α (FreeCont r) β → FreeCont r α) (k : end FreeCont -/-- Type constructor for reader operations. -/ -inductive ReaderF (σ : Type u) : Type u → Type u where - | read : ReaderF σ σ - -/-- Reader monad via the `FreeM` monad -/ -abbrev FreeReader (σ) := FreeM (ReaderF σ) - -namespace FreeReader - -variable {σ : Type u} {α : Type u} - -instance : MonadReaderOf σ (FreeReader σ) where - read := .lift .read - -@[simp] -lemma read_def : (read : FreeReader σ σ) = .lift .read := rfl - -instance : MonadReader σ (FreeReader σ) := inferInstance - -/-- Interpret `ReaderF` operations into `ReaderM`. -/ -def readInterp {α : Type u} : ReaderF σ α → ReaderM σ α - | .read => MonadReaderOf.read - -/-- Convert a `FreeReader` computation into a `ReaderM` computation. This is the canonical -interpreter derived from `liftM`. -/ -def toReaderM {α : Type u} (comp : FreeReader σ α) : ReaderM σ α := - comp.liftM readInterp - -/-- `toReaderM` is the unique interpreter extending `readInterp`. -/ -theorem toReaderM_unique {α : Type u} (g : FreeReader σ α → ReaderM σ α) - (h : Interprets readInterp g) : g = toReaderM := h.eq - -/-- Run a reader computation -/ -def run (comp : FreeReader σ α) (s₀ : σ) : α := - match comp with - | .pure a => a - | .liftBind ReaderF.read a => run (a s₀) s₀ - -/-- -The canonical interpreter `toReaderM` derived from `liftM` agrees with the hand-written -recursive interpreter `run` for `FreeReader` -/ -@[simp] -theorem run_toReaderM {α : Type u} (comp : FreeReader σ α) (s : σ) : - (toReaderM comp).run s = run comp s := by - induction comp generalizing s with - | pure a => rfl - | liftBind op cont ih => - cases op; apply ih - -@[simp] -lemma run_pure (a : α) (s₀ : σ) : - run (.pure a : FreeReader σ α) s₀ = a := rfl - -@[simp] -lemma run_read (k : σ → FreeReader σ α) (s₀ : σ) : - run (liftBind .read k) s₀ = run (k s₀) s₀ := rfl - -instance instMonadWithReaderOf : MonadWithReaderOf σ (FreeReader σ) where - withReader {α} f m := - let rec go : FreeReader σ α → FreeReader σ α - | .pure a => .pure a - | .liftBind .read cont => - .liftBind .read fun s => go (cont (f s)) - go m - -@[simp] theorem run_withReader (f : σ → σ) (m : FreeReader σ α) (s : σ) : - run (withTheReader σ f m) s = run m (f s) := by - induction m generalizing s with - | pure a => rfl - | liftBind op cont ih => - cases op - simpa [withTheReader, instMonadWithReaderOf, run] using (ih (f s) s) - -end FreeReader - end FreeM end Cslib From 3267a70024449d54479510e705a3ca6a3c47234c Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 21 Jan 2026 18:16:47 +0100 Subject: [PATCH 016/176] Some progress on the example --- Cslib/Algorithms/MergeSort/MergeSort.lean | 74 ++++++++++++++--------- Cslib/Algorithms/QueryModel.lean | 2 +- 2 files changed, 46 insertions(+), 30 deletions(-) diff --git a/Cslib/Algorithms/MergeSort/MergeSort.lean b/Cslib/Algorithms/MergeSort/MergeSort.lean index 222619fb0..605b9b979 100644 --- a/Cslib/Algorithms/MergeSort/MergeSort.lean +++ b/Cslib/Algorithms/MergeSort/MergeSort.lean @@ -28,40 +28,56 @@ namespace Cslib.Algorithms.MergeSort.QueryBased open Cslib.Algorithms -/-- The Model for comparison sorting natural-number registers.-/ -inductive QueryF : Type → Type where - /-- Read the value stored at index `i`. -/ - | read : Nat → QueryF Nat - /-- Write value `v` at index `i`. -/ - | write : Nat → Nat → QueryF PUnit - /-- Compare the values at indices `i` and `j`. -/ - | cmp : Nat → Nat → QueryF Bool - -/-- Lift a comparison into the query language at the top level. -/ -def cmpVal (x y : Nat) : Prog Bool := - FreeM.lift (QueryF.cmp x y) - -/-- Concrete semantics for primitive queries, used to run programs. -/ -def evalQuery : {ι : Type} → QueryF ι → ι - | _, .read _ => 0 - | _, .write _ _ => PUnit.unit - | _, .cmp x y => x ≤ y - - - - -abbrev SortProg := Prog QueryF +/-- The Model for comparison sorting natural-number registers. +-/ +inductive ListSortOps (α : Type) : Type → Type where + | cmp : (l : List α) → (i j : Fin l.length) → ListSortOps α Bool + | write : (l : List α) → (i : Fin l.length) → (x : α) → ListSortOps α (List α) + | read : (l : List α) → (i : Fin l.length) → ListSortOps α α + + +def ListSort_WorstCase [DecidableEq α] : Model (ListSortOps α) where + evalQuery q := + match q with + | .write l i x => l.set i x + | .cmp l i j => l[i] == l[j] + | .read l i => l.get i + cost q := + match q with + | .write l i x => l.length + | .read l i => l.length + | .cmp l i j => l.length + +/-- +The array version of the sort operations +-/ +inductive ArraySortOps (α : Type) : Type → Type where + | swap : (a : Array α) → (i j : Fin a.size) → ArraySortOps α (Array α) + | cmp : (a : Array α) → (i j : Fin a.size) → ArraySortOps α Bool + | write : (a : Array α) → (i : Fin a.size) → (x : α) → ArraySortOps α (Array α) + | read : (a : Array α) → (i : Fin a.size) → ArraySortOps α α + +def ArraySort_WorstCase [DecidableEq α] : Model (ArraySortOps α) where + evalQuery q := + match q with + | .write a i x => a.set i x + | .cmp l i j => l[i] == l[j] + | .read l i => l[i] + | .swap l i j => l.swap i j + cost q := + match q with + | .write l i x => 1 + | .read l i => 1 + | .cmp l i j => 1 + | .swap l i j => 1 -/-- Lift a comparison on values into the free monad. -/ -def cmpVal (x y : Nat) : SortProg Bool := - FreeM.lift (QueryF.cmp x y) /-- Merge two sorted lists using comparisons in the query monad. -/ -def merge : List Nat → List Nat → SortProg (List Nat) +def merge [DecidableEq α] (x y : List Nat) : Prog ListSortOps Nat | [], ys => pure ys | xs, [] => pure xs | x :: xs', y :: ys' => do - let b ← cmpVal x y + let b ← x ≤ y if b then let rest ← merge xs' (y :: ys') pure (x :: rest) @@ -79,7 +95,7 @@ def split (xs : List Nat) : List Nat × List Nat := /-- Merge sort expressed as a program in the query model. TODO: Working version without partial -/ -partial def mergeSort : List Nat → SortProg (List Nat) +partial def mergeSort : List Nat → Prog (List Nat) | [] => pure [] | [x] => pure [x] | xs => diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 3439973d1..1a3d0f72f 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -64,7 +64,7 @@ inductive ListOps (α : Type) : Type → Type where | write : (l : List α) → (i : Fin l.length) → (x : α) → ListOps α (List α) -instance List_LinSearch_WorstCase [DecidableEq α] : Model (ListOps α) where +def List_LinSearch_WorstCase [DecidableEq α] : Model (ListOps α) where evalQuery q := match q with | .write l i x => l.set i x From 48755f04d3dabe002e03cc91227e7d3c650aaeb7 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 21 Jan 2026 18:24:01 +0100 Subject: [PATCH 017/176] Dangers of using only pure ops --- Cslib/Algorithms/MergeSort/MergeSort.lean | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/Cslib/Algorithms/MergeSort/MergeSort.lean b/Cslib/Algorithms/MergeSort/MergeSort.lean index 605b9b979..70338aec5 100644 --- a/Cslib/Algorithms/MergeSort/MergeSort.lean +++ b/Cslib/Algorithms/MergeSort/MergeSort.lean @@ -25,7 +25,7 @@ open Cslib namespace Cslib.Algorithms.MergeSort.QueryBased -open Cslib.Algorithms +open Cslib.Algorithms Model /-- The Model for comparison sorting natural-number registers. @@ -73,12 +73,12 @@ def ArraySort_WorstCase [DecidableEq α] : Model (ArraySortOps α) where /-- Merge two sorted lists using comparisons in the query monad. -/ -def merge [DecidableEq α] (x y : List Nat) : Prog ListSortOps Nat +def merge (x y : List Nat) : Prog (ListSortOps Nat) (List Nat) := do + match x,y with | [], ys => pure ys | xs, [] => pure xs | x :: xs', y :: ys' => do - let b ← x ≤ y - if b then + if x ≤ y then let rest ← merge xs' (y :: ys') pure (x :: rest) else @@ -95,7 +95,7 @@ def split (xs : List Nat) : List Nat × List Nat := /-- Merge sort expressed as a program in the query model. TODO: Working version without partial -/ -partial def mergeSort : List Nat → Prog (List Nat) +partial def mergeSort : List Nat → Prog (ListSortOps Nat) (List Nat) | [] => pure [] | [x] => pure [x] | xs => @@ -105,7 +105,7 @@ partial def mergeSort : List Nat → Prog (List Nat) let sortedRight ← mergeSort right merge sortedLeft sortedRight -#eval evalProg (mergeSort [5,3,8,6,2,7,4,1]) -#eval timeProg (mergeSort [5,3,8,6,2,7,4,1]) +#eval Prog.eval (mergeSort [5,3,8,6,2,7,4,1]) ListSort_WorstCase +#eval Prog.time (mergeSort [5,3,8,6,2,7,4,1]) ListSort_WorstCase end Cslib.Algorithms.MergeSort.QueryBased From da183e1417a15e1b6fa76174d2bcadc88b5999df Mon Sep 17 00:00:00 2001 From: Shreyas Date: Thu, 22 Jan 2026 01:57:00 +0100 Subject: [PATCH 018/176] experiments --- Cslib/Algorithms/MergeSort/MergeSort.lean | 76 ++++++++++++----------- Cslib/Algorithms/QueryModel.lean | 26 +++++++- 2 files changed, 65 insertions(+), 37 deletions(-) diff --git a/Cslib/Algorithms/MergeSort/MergeSort.lean b/Cslib/Algorithms/MergeSort/MergeSort.lean index 70338aec5..feec2d382 100644 --- a/Cslib/Algorithms/MergeSort/MergeSort.lean +++ b/Cslib/Algorithms/MergeSort/MergeSort.lean @@ -71,41 +71,45 @@ def ArraySort_WorstCase [DecidableEq α] : Model (ArraySortOps α) where | .cmp l i j => 1 | .swap l i j => 1 - -/-- Merge two sorted lists using comparisons in the query monad. -/ -def merge (x y : List Nat) : Prog (ListSortOps Nat) (List Nat) := do - match x,y with - | [], ys => pure ys - | xs, [] => pure xs - | x :: xs', y :: ys' => do - if x ≤ y then - let rest ← merge xs' (y :: ys') - pure (x :: rest) - else - let rest ← merge (x :: xs') ys' - pure (y :: rest) - -/-- Split a list into two lists by alternating elements. -/ -def split (xs : List Nat) : List Nat × List Nat := - let rec go : List Nat → List Nat → List Nat → List Nat × List Nat - | [], accL, accR => (accL.reverse, accR.reverse) - | [x], accL, accR => ((x :: accL).reverse, accR.reverse) - | x :: y :: xs, accL, accR => go xs (x :: accL) (y :: accR) - go xs [] [] - -/-- Merge sort expressed as a program in the query model. -TODO: Working version without partial -/ -partial def mergeSort : List Nat → Prog (ListSortOps Nat) (List Nat) - | [] => pure [] - | [x] => pure [x] - | xs => - let (left, right) := split xs - do - let sortedLeft ← mergeSort left - let sortedRight ← mergeSort right - merge sortedLeft sortedRight - -#eval Prog.eval (mergeSort [5,3,8,6,2,7,4,1]) ListSort_WorstCase -#eval Prog.time (mergeSort [5,3,8,6,2,7,4,1]) ListSort_WorstCase +def exampleCode (a : Array Int) (h : a.size > 0): Prog (ArraySortOps Int) (Int) := do + for hi : i in [:a.size] do + return ArraySortOps.write a ⟨i, by grind⟩ 1 + return (ArraySortOps.read a ⟨0, by grind⟩) + +-- /-- Merge two sorted lists using comparisons in the query monad. -/ +-- def merge (x y : List Nat) : Prog (ListSortOps Nat) (List Nat) := do +-- match x,y with +-- | [], ys => pure ys +-- | xs, [] => pure xs +-- | x :: xs', y :: ys' => do +-- if x ≤ y then +-- let rest ← merge xs' (y :: ys') +-- pure (x :: rest) +-- else +-- let rest ← merge (x :: xs') ys' +-- pure (y :: rest) + +-- /-- Split a list into two lists by alternating elements. -/ +-- def split (xs : List Nat) : List Nat × List Nat := +-- let rec go : List Nat → List Nat → List Nat → List Nat × List Nat +-- | [], accL, accR => (accL.reverse, accR.reverse) +-- | [x], accL, accR => ((x :: accL).reverse, accR.reverse) +-- | x :: y :: xs, accL, accR => go xs (x :: accL) (y :: accR) +-- go xs [] [] + +-- /-- Merge sort expressed as a program in the query model. +-- TODO: Working version without partial -/ +-- partial def mergeSort : List Nat → Prog (ListSortOps Nat) (List Nat) +-- | [] => pure [] +-- | [x] => pure [x] +-- | xs => +-- let (left, right) := split xs +-- do +-- let sortedLeft ← mergeSort left +-- let sortedRight ← mergeSort right +-- merge sortedLeft sortedRight + +-- #eval Prog.eval (mergeSort [5,3,8,6,2,7,4,1]) ListSort_WorstCase +-- #eval Prog.time (mergeSort [5,3,8,6,2,7,4,1]) ListSort_WorstCase end Cslib.Algorithms.MergeSort.QueryBased diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 1a3d0f72f..6d7521bf0 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -9,7 +9,7 @@ module public import Mathlib public import Cslib.Foundations.Control.Monad.Free.Effects public import Cslib.Foundations.Control.Monad.Free.Fold - +public import Batteries @[expose] public section @@ -135,6 +135,8 @@ end Examples -- | seq (p₁ : Prog Q ι) (cont : ι → Prog Q α) : Prog Q α abbrev Prog Q α := FreeM Q α + +#print FreeM namespace Prog def eval (P : Prog Q α) (M : Model Q) : α := @@ -152,6 +154,28 @@ def time (P : Prog Q α) (M : Model Q) : Nat := let qval := M.evalQuery op t₁ + (time (cont qval) M) +def interpretQueryIntoTime (M : Model Q) (q : Q α) : TimeM α where + ret := M.evalQuery q + time := M.cost q +def interpretProgIntoTime (P : Prog Q α) (M : Model Q) : TimeM α where + ret := eval P M + time := time P M + +def liftProgIntoTime (M : Model Q) (P : Prog Q α) : TimeM α := + P.liftM (interpretQueryIntoTime M) + + +-- This lemma is a sanity check. This is the only place `TimeM` is used. +lemma timing_is_identical : ∀ (P : Prog Q α) (M : Model Q), + time P M = (liftProgIntoTime M P).time := by + intro P pm + induction P with + | pure a => + simp [time,liftProgIntoTime] + | liftBind op cont ih => + expose_names + simp_all [time, liftProgIntoTime, interpretQueryIntoTime] + end Prog end Model From 29a59085b0cd04490f0a5b6a2fe44b62dcc808e6 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Thu, 22 Jan 2026 17:33:59 +0100 Subject: [PATCH 019/176] Simple example --- Cslib/Algorithms/MergeSort/MergeSort.lean | 12 +++-- Cslib/Algorithms/QueryModel.lean | 58 +++++++++++++++-------- 2 files changed, 47 insertions(+), 23 deletions(-) diff --git a/Cslib/Algorithms/MergeSort/MergeSort.lean b/Cslib/Algorithms/MergeSort/MergeSort.lean index feec2d382..abdc27294 100644 --- a/Cslib/Algorithms/MergeSort/MergeSort.lean +++ b/Cslib/Algorithms/MergeSort/MergeSort.lean @@ -71,10 +71,14 @@ def ArraySort_WorstCase [DecidableEq α] : Model (ArraySortOps α) where | .cmp l i j => 1 | .swap l i j => 1 -def exampleCode (a : Array Int) (h : a.size > 0): Prog (ArraySortOps Int) (Int) := do - for hi : i in [:a.size] do - return ArraySortOps.write a ⟨i, by grind⟩ 1 - return (ArraySortOps.read a ⟨0, by grind⟩) +notation " ✓✓ " query => FreeM.lift query + +variable (a : Array Int) (ha : a.size > 2) +#check ✓✓ ArraySortOps.write a ⟨1, by grind⟩ 1 +def exampleCode (a : Array Int) (h : a.size > 2): Prog (ArraySortOps Int) (Int) := do + let a'' ← ✓✓ ArraySortOps.write a ⟨1, by grind⟩ 1 + return <| ✓✓ ArraySortOps.read a'' ⟨0, by grind⟩ + -- /-- Merge two sorted lists using comparisons in the query monad. -/ -- def merge (x y : List Nat) : Prog (ListSortOps Nat) (List Nat) := do diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 6d7521bf0..6652e84e7 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -109,24 +109,10 @@ def Array_BinSearch_WorstCase [BEq α] : Model (ArrayOps α) where | .write l i x => 1 | .get l x => 1 -inductive Arith (α : Type) : Type → Type where - | add (x y : α) : Arith α α - | mul (x y : α) : Arith α α - | neg (x : α) : Arith α α - | zero : Arith α α - | one : Arith α α -noncomputable def RealArithQuery : Model (Arith ℝ) where - evalQuery q := - match q with - | .add x y => x + y - | .mul x y => x * y - | .neg x => -x - | .zero => (0 : ℝ) - | .one => (1 : ℝ) - cost _ := 1 end Examples +end Model -- ALternative def where pure has to be a query -- /-- Programs built as the free ~~monad~~ arrow? over `QueryF`. -/ @@ -135,8 +121,6 @@ end Examples -- | seq (p₁ : Prog Q ι) (cont : ι → Prog Q α) : Prog Q α abbrev Prog Q α := FreeM Q α - -#print FreeM namespace Prog def eval (P : Prog Q α) (M : Model Q) : α := @@ -176,9 +160,45 @@ lemma timing_is_identical : ∀ (P : Prog Q α) (M : Model Q), expose_names simp_all [time, liftProgIntoTime, interpretQueryIntoTime] -end Prog +section ProgExamples -end Model +inductive Arith (α : Type) : Type → Type where + | add (x y : α) : Arith α α + | mul (x y : α) : Arith α α + | neg (x : α) : Arith α α + | zero : Arith α α + | one : Arith α α + +def RatArithQuery : Model (Arith ℚ) where + evalQuery q := + match q with + | .add x y => x + y + | .mul x y => x * y + | .neg x => -x + | .zero => (0 : ℚ) + | .one => (1 : ℚ) + cost _ := 1 + +def add (x y : ℚ) : Prog (Arith ℚ) ℚ := FreeM.lift <| Arith.add x y +def mul (x y : ℚ) : Prog (Arith ℚ) ℚ := FreeM.lift <| Arith.mul x y +def neg (x : ℚ) : Prog (Arith ℚ) ℚ := FreeM.lift <| Arith.neg x +def zero : Prog (Arith ℚ) ℚ := FreeM.lift Arith.zero +def one : Prog (Arith ℚ) ℚ := FreeM.lift Arith.one + +def ex1 : Prog (Arith ℚ) ℚ := do + let mut x ← zero + let mut y ← one + let z ← add x y + let w ← add z y + add w z + +#eval ex1.eval RatArithQuery + +#eval ex1.time RatArithQuery + +end ProgExamples + +end Prog end Algorithms From 65d820dfadf0e17ba6a806907024838afa6134a3 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Thu, 22 Jan 2026 17:35:58 +0100 Subject: [PATCH 020/176] Simple example --- Cslib/Algorithms/QueryModel.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 6652e84e7..dbd8e8422 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -188,7 +188,7 @@ def one : Prog (Arith ℚ) ℚ := FreeM.lift Arith.one def ex1 : Prog (Arith ℚ) ℚ := do let mut x ← zero let mut y ← one - let z ← add x y + let z ← add (x + y + y) y let w ← add z y add w z From 6c2835f2d42e7bc14de561cd8716583dbfd7b37a Mon Sep 17 00:00:00 2001 From: Shreyas Date: Thu, 22 Jan 2026 18:09:49 +0100 Subject: [PATCH 021/176] Developing array sort example --- Cslib/Algorithms/MergeSort/MergeSort.lean | 36 ++----------- Cslib/Algorithms/QueryModel.lean | 63 ++++++++++++++++++++++- 2 files changed, 67 insertions(+), 32 deletions(-) diff --git a/Cslib/Algorithms/MergeSort/MergeSort.lean b/Cslib/Algorithms/MergeSort/MergeSort.lean index abdc27294..6dbfa563e 100644 --- a/Cslib/Algorithms/MergeSort/MergeSort.lean +++ b/Cslib/Algorithms/MergeSort/MergeSort.lean @@ -4,7 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Tanner Duve -/ -import Cslib.Algorithms.QueryModel +module + +public import Cslib.Algorithms.QueryModel + +@[expose] public section /-! # Merge sort in the query model @@ -48,37 +52,7 @@ def ListSort_WorstCase [DecidableEq α] : Model (ListSortOps α) where | .read l i => l.length | .cmp l i j => l.length -/-- -The array version of the sort operations --/ -inductive ArraySortOps (α : Type) : Type → Type where - | swap : (a : Array α) → (i j : Fin a.size) → ArraySortOps α (Array α) - | cmp : (a : Array α) → (i j : Fin a.size) → ArraySortOps α Bool - | write : (a : Array α) → (i : Fin a.size) → (x : α) → ArraySortOps α (Array α) - | read : (a : Array α) → (i : Fin a.size) → ArraySortOps α α -def ArraySort_WorstCase [DecidableEq α] : Model (ArraySortOps α) where - evalQuery q := - match q with - | .write a i x => a.set i x - | .cmp l i j => l[i] == l[j] - | .read l i => l[i] - | .swap l i j => l.swap i j - cost q := - match q with - | .write l i x => 1 - | .read l i => 1 - | .cmp l i j => 1 - | .swap l i j => 1 - -notation " ✓✓ " query => FreeM.lift query - -variable (a : Array Int) (ha : a.size > 2) -#check ✓✓ ArraySortOps.write a ⟨1, by grind⟩ 1 -def exampleCode (a : Array Int) (h : a.size > 2): Prog (ArraySortOps Int) (Int) := do - let a'' ← ✓✓ ArraySortOps.write a ⟨1, by grind⟩ 1 - return <| ✓✓ ArraySortOps.read a'' ⟨0, by grind⟩ - -- /-- Merge two sorted lists using comparisons in the query monad. -/ -- def merge (x y : List Nat) : Prog (ListSortOps Nat) (List Nat) := do diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index dbd8e8422..ecc89c0e9 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -189,13 +189,74 @@ def ex1 : Prog (Arith ℚ) ℚ := do let mut x ← zero let mut y ← one let z ← add (x + y + y) y - let w ← add z y + let w ← neg <| ←(add z y) add w z #eval ex1.eval RatArithQuery #eval ex1.time RatArithQuery + +section ArraySort +/-- +The array version of the sort operations +-/ +inductive ArraySortOps (α : Type) : Type → Type where + | swap : (a : Array α) → (i j : Fin a.size) → ArraySortOps α (Array α) + | cmp : (a : Array α) → (i j : Fin a.size) → ArraySortOps α Bool + | write : (a : Array α) → (i : Fin a.size) → (x : α) → ArraySortOps α (Array α) + | read : (a : Array α) → (i : Fin a.size) → ArraySortOps α α + | push : (a : Array α) → (elem : α) → ArraySortOps α (Array α) + +def ArraySort_WorstCase [DecidableEq α] : Model (ArraySortOps α) where + evalQuery q := + match q with + | .write a i x => a.set i x + | .cmp l i j => l[i] == l[j] + | .read l i => l[i] + | .swap l i j => l.swap i j + | .push a elem => a.push elem + cost q := + match q with + | .write l i x => 1 + | .read l i => 1 + | .cmp l i j => 1 + | .swap l i j => 1 + | .push a elem => 2 -- amortized over array insertion and resizing by doubling + +def swapOp [LinearOrder α] + (a : Array α) (i j : Fin a.size) : Prog (ArraySortOps α) (Array α) := + FreeM.lift <| ArraySortOps.swap a ⟨i, by grind⟩ ⟨j, by grind⟩ + +def cmp [LinearOrder α] + (a : Array α) (i j : ℕ) + (hi : i < a.size := by grind) + (hj : j < a.size := by grind) : Prog (ArraySortOps α) Bool := + FreeM.lift <| ArraySortOps.cmp a ⟨i, hi⟩ ⟨j, hj⟩ + +def writeOp [LinearOrder α] + (a : Array α) (i : Fin a.size) (x : α) : Prog (ArraySortOps α) (Array α) := + FreeM.lift <| ArraySortOps.write a ⟨i, by grind⟩ x + +def read [LinearOrder α] + (a : Array α) (i : Fin a.size) : Prog (ArraySortOps α) α := + FreeM.lift <| ArraySortOps.read a ⟨i, by grind⟩ + + +def simpleExample (a : Array ℤ) (i k : ℕ) + (hi : i < a.size := by grind) + (hk : k < a.size := by grind): Prog (ArraySortOps ℤ) (Array ℤ) := do + let b ← writeOp a ⟨i, hi⟩ 10 + have : b.size = a.size := by + sorry + swapOp b ⟨i, this ▸ hi⟩ ⟨k, this ▸ hk⟩ + +#eval (simpleExample #[1,2,3,4,5] 0 2).eval ArraySort_WorstCase +#eval (simpleExample #[1,2,3,4,5] 0 2).time ArraySort_WorstCase + +end ArraySort + + end ProgExamples end Prog From 0684bdda25efa2d86c4781b8595158c0629c69e6 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Thu, 22 Jan 2026 18:11:36 +0100 Subject: [PATCH 022/176] Developing array sort example --- Cslib/Algorithms/QueryModel.lean | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index ecc89c0e9..486b39ba7 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -225,8 +225,9 @@ def ArraySort_WorstCase [DecidableEq α] : Model (ArraySortOps α) where | .push a elem => 2 -- amortized over array insertion and resizing by doubling def swapOp [LinearOrder α] - (a : Array α) (i j : Fin a.size) : Prog (ArraySortOps α) (Array α) := - FreeM.lift <| ArraySortOps.swap a ⟨i, by grind⟩ ⟨j, by grind⟩ + (a : Array α) (i j : ℕ) (hi : i < a.size := by grind) + (hj : j < a.size := by grind) : Prog (ArraySortOps α) (Array α) := + FreeM.lift <| ArraySortOps.swap a ⟨i, hi⟩ ⟨j, hj⟩ def cmp [LinearOrder α] (a : Array α) (i j : ℕ) From b8c18b000531d6deda4399d9498f31910d8bb127 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Thu, 22 Jan 2026 21:47:03 +0100 Subject: [PATCH 023/176] Vectors --- Cslib/Algorithms/MergeSort/MergeSort.lean | 2 - Cslib/Algorithms/QueryModel.lean | 74 +++++++++++------------ 2 files changed, 35 insertions(+), 41 deletions(-) diff --git a/Cslib/Algorithms/MergeSort/MergeSort.lean b/Cslib/Algorithms/MergeSort/MergeSort.lean index 6dbfa563e..d0029094a 100644 --- a/Cslib/Algorithms/MergeSort/MergeSort.lean +++ b/Cslib/Algorithms/MergeSort/MergeSort.lean @@ -29,8 +29,6 @@ open Cslib namespace Cslib.Algorithms.MergeSort.QueryBased -open Cslib.Algorithms Model - /-- The Model for comparison sorting natural-number registers. -/ diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 486b39ba7..9cdf1dcc4 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -121,8 +121,11 @@ end Model -- | seq (p₁ : Prog Q ι) (cont : ι → Prog Q α) : Prog Q α abbrev Prog Q α := FreeM Q α +instance {Q α} : Coe (Q α) (outParam <| Prog Q α) where + coe := FreeM.lift namespace Prog + def eval (P : Prog Q α) (M : Model Q) : α := match P with | .pure x => x @@ -179,18 +182,16 @@ def RatArithQuery : Model (Arith ℚ) where | .one => (1 : ℚ) cost _ := 1 -def add (x y : ℚ) : Prog (Arith ℚ) ℚ := FreeM.lift <| Arith.add x y -def mul (x y : ℚ) : Prog (Arith ℚ) ℚ := FreeM.lift <| Arith.mul x y -def neg (x : ℚ) : Prog (Arith ℚ) ℚ := FreeM.lift <| Arith.neg x -def zero : Prog (Arith ℚ) ℚ := FreeM.lift Arith.zero -def one : Prog (Arith ℚ) ℚ := FreeM.lift Arith.one +open Arith + -def ex1 : Prog (Arith ℚ) ℚ := do + +def ex1 [Coe (Arith ℚ ℚ) (Prog (Arith ℚ) ℚ)] : Prog (Arith ℚ) ℚ := do let mut x ← zero - let mut y ← one - let z ← add (x + y + y) y - let w ← neg <| ←(add z y) - add w z + let mut y ← Coe.coe one + let z ← Coe.coe (add (x + y + y) y) + let w ← Coe.coe <| neg <| ←(Coe.coe <| add z y) + Coe.coe <| add w z #eval ex1.eval RatArithQuery @@ -201,21 +202,22 @@ section ArraySort /-- The array version of the sort operations -/ -inductive ArraySortOps (α : Type) : Type → Type where - | swap : (a : Array α) → (i j : Fin a.size) → ArraySortOps α (Array α) - | cmp : (a : Array α) → (i j : Fin a.size) → ArraySortOps α Bool - | write : (a : Array α) → (i : Fin a.size) → (x : α) → ArraySortOps α (Array α) - | read : (a : Array α) → (i : Fin a.size) → ArraySortOps α α - | push : (a : Array α) → (elem : α) → ArraySortOps α (Array α) - -def ArraySort_WorstCase [DecidableEq α] : Model (ArraySortOps α) where +inductive VecSortOps (α : Type) : Type → Type where + | swap : (a : Vector α n) → (i j : Fin n) → VecSortOps α (Vector α n) + | cmp : (a : Vector α n) → (i j : Fin n) → VecSortOps α 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)) + +def VecSort_WorstCase [DecidableEq α] : Model (VecSortOps α) where evalQuery q := match q with - | .write a i x => a.set i x + | .write v i x => v.set i x | .cmp l i j => l[i] == l[j] | .read l i => l[i] | .swap l i j => l.swap i j | .push a elem => a.push elem + cost q := match q with | .write l i x => 1 @@ -225,35 +227,29 @@ def ArraySort_WorstCase [DecidableEq α] : Model (ArraySortOps α) where | .push a elem => 2 -- amortized over array insertion and resizing by doubling def swapOp [LinearOrder α] - (a : Array α) (i j : ℕ) (hi : i < a.size := by grind) - (hj : j < a.size := by grind) : Prog (ArraySortOps α) (Array α) := - FreeM.lift <| ArraySortOps.swap a ⟨i, hi⟩ ⟨j, hj⟩ + (v : Vector α n) (i j : Fin n) : Prog (VecSortOps α) (Vector α n) := + FreeM.lift <| VecSortOps.swap v i j def cmp [LinearOrder α] - (a : Array α) (i j : ℕ) - (hi : i < a.size := by grind) - (hj : j < a.size := by grind) : Prog (ArraySortOps α) Bool := - FreeM.lift <| ArraySortOps.cmp a ⟨i, hi⟩ ⟨j, hj⟩ + (v : Vector α n) (i j : Fin n) : Prog (VecSortOps α) Bool := + FreeM.lift <| VecSortOps.cmp v i j def writeOp [LinearOrder α] - (a : Array α) (i : Fin a.size) (x : α) : Prog (ArraySortOps α) (Array α) := - FreeM.lift <| ArraySortOps.write a ⟨i, by grind⟩ x + (v : Vector α n) (i : Fin n) (x : α) : Prog (VecSortOps α) (Vector α n) := + FreeM.lift <| VecSortOps.write v i x def read [LinearOrder α] - (a : Array α) (i : Fin a.size) : Prog (ArraySortOps α) α := - FreeM.lift <| ArraySortOps.read a ⟨i, by grind⟩ + (v : Vector α n) (i : Fin n) : Prog (VecSortOps α) α := + FreeM.lift <| VecSortOps.read v i -def simpleExample (a : Array ℤ) (i k : ℕ) - (hi : i < a.size := by grind) - (hk : k < a.size := by grind): Prog (ArraySortOps ℤ) (Array ℤ) := do - let b ← writeOp a ⟨i, hi⟩ 10 - have : b.size = a.size := by - sorry - swapOp b ⟨i, this ▸ hi⟩ ⟨k, this ▸ hk⟩ +def simpleExample (v : Vector ℤ n) (i k : Fin n) + : Prog (VecSortOps ℤ) (Vector ℤ n) := do + let b ← writeOp v i 10 + swapOp b i k -#eval (simpleExample #[1,2,3,4,5] 0 2).eval ArraySort_WorstCase -#eval (simpleExample #[1,2,3,4,5] 0 2).time ArraySort_WorstCase +#eval (simpleExample #v[1,2,3,4,5] 0 2).eval VecSort_WorstCase +#eval (simpleExample #v[1,2,3,4,5] 0 2).time VecSort_WorstCase end ArraySort From f859a4173922f1586c30f457f8d73c06b747f5fd Mon Sep 17 00:00:00 2001 From: Shreyas Date: Thu, 22 Jan 2026 21:47:58 +0100 Subject: [PATCH 024/176] Vectors --- Cslib/Algorithms/QueryModel.lean | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 9cdf1dcc4..8692825cf 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -226,7 +226,7 @@ def VecSort_WorstCase [DecidableEq α] : Model (VecSortOps α) where | .swap l i j => 1 | .push a elem => 2 -- amortized over array insertion and resizing by doubling -def swapOp [LinearOrder α] +def swap [LinearOrder α] (v : Vector α n) (i j : Fin n) : Prog (VecSortOps α) (Vector α n) := FreeM.lift <| VecSortOps.swap v i j @@ -234,7 +234,7 @@ def cmp [LinearOrder α] (v : Vector α n) (i j : Fin n) : Prog (VecSortOps α) Bool := FreeM.lift <| VecSortOps.cmp v i j -def writeOp [LinearOrder α] +def write [LinearOrder α] (v : Vector α n) (i : Fin n) (x : α) : Prog (VecSortOps α) (Vector α n) := FreeM.lift <| VecSortOps.write v i x @@ -245,8 +245,9 @@ def read [LinearOrder α] def simpleExample (v : Vector ℤ n) (i k : Fin n) : Prog (VecSortOps ℤ) (Vector ℤ n) := do - let b ← writeOp v i 10 - swapOp b i k + let b ← write v i 10 + _ ← swap b i k + swap v k i #eval (simpleExample #v[1,2,3,4,5] 0 2).eval VecSort_WorstCase #eval (simpleExample #v[1,2,3,4,5] 0 2).time VecSort_WorstCase From 912890d1a4752851c7a5c28e6ced738a57a58e00 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 23 Jan 2026 00:16:56 +0100 Subject: [PATCH 025/176] Made coercions work. Added custom cost structures --- Cslib/Algorithms/QueryModel.lean | 79 ++++++++++++++++++++++---------- 1 file changed, 55 insertions(+), 24 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 8692825cf..a03abcfd6 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -37,14 +37,14 @@ namespace Cslib namespace Algorithms -class Model (QType : Type u → Type u) where +class Model (QType : Type u → Type u) (Cost : Type) [Add Cost] [Zero Cost] where evalQuery : QType ι → ι - cost : QType ι → ℕ + cost : QType ι → Cost namespace Model def interpretTimeM - [M : Model Q] (q : Q ι) : TimeM ι where + (M : Model Q ℕ) (q : Q ι) : TimeM ι where ret := M.evalQuery q time := M.cost q @@ -64,7 +64,7 @@ inductive ListOps (α : Type) : Type → Type where | write : (l : List α) → (i : Fin l.length) → (x : α) → ListOps α (List α) -def List_LinSearch_WorstCase [DecidableEq α] : Model (ListOps α) where +def List_LinSearch_WorstCase [DecidableEq α] : Model (ListOps α) ℕ where evalQuery q := match q with | .write l i x => l.set i x @@ -78,7 +78,7 @@ def List_LinSearch_WorstCase [DecidableEq α] : Model (ListOps α) where -def List_BinSearch_WorstCase [BEq α] : Model (ListOps α) where +def List_BinSearch_WorstCase [BEq α] : Model (ListOps α) ℕ where evalQuery q := match q with | .write l i x => l.set i x @@ -96,7 +96,7 @@ inductive ArrayOps (α : Type) : Type → Type where | find : (l : Array α) → α → ArrayOps α ℕ | write : (l : Array α) → (i : Fin l.size) → (x : α) → ArrayOps α (Array α) -def Array_BinSearch_WorstCase [BEq α] : Model (ArrayOps α) where +def Array_BinSearch_WorstCase [BEq α] : Model (ArrayOps α) ℕ where evalQuery q := match q with | .write l i x => l.set i x @@ -121,19 +121,21 @@ end Model -- | seq (p₁ : Prog Q ι) (cont : ι → Prog Q α) : Prog Q α abbrev Prog Q α := FreeM Q α -instance {Q α} : Coe (Q α) (outParam <| Prog Q α) where + +instance {Q α} : Coe (Q α) (FreeM Q α) where coe := FreeM.lift namespace Prog -def eval (P : Prog Q α) (M : Model Q) : α := +def eval [Add Cost] [Zero Cost] + (P : Prog Q α) (M : Model Q Cost) : α := match P with | .pure x => x | .liftBind op cont => let qval := M.evalQuery op eval (cont qval) M -def time (P : Prog Q α) (M : Model Q) : Nat := +def time [Add Cost] [Zero Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := match P with | .pure _ => 0 | .liftBind op cont => @@ -141,19 +143,22 @@ def time (P : Prog Q α) (M : Model Q) : Nat := let qval := M.evalQuery op t₁ + (time (cont qval) M) -def interpretQueryIntoTime (M : Model Q) (q : Q α) : TimeM α where +section TimeM + +-- The below is a proof of concept and pointless +def interpretQueryIntoTime (M : Model Q ℕ) (q : Q α) : TimeM α where ret := M.evalQuery q time := M.cost q -def interpretProgIntoTime (P : Prog Q α) (M : Model Q) : TimeM α where +def interpretProgIntoTime (P : Prog Q α) (M : Model Q ℕ) : TimeM α where ret := eval P M time := time P M -def liftProgIntoTime (M : Model Q) (P : Prog Q α) : TimeM α := +def liftProgIntoTime (M : Model Q ℕ) (P : Prog Q α) : TimeM α := P.liftM (interpretQueryIntoTime M) -- This lemma is a sanity check. This is the only place `TimeM` is used. -lemma timing_is_identical : ∀ (P : Prog Q α) (M : Model Q), +lemma timing_is_identical : ∀ (P : Prog Q α) (M : Model Q ℕ), time P M = (liftProgIntoTime M P).time := by intro P pm induction P with @@ -163,6 +168,8 @@ lemma timing_is_identical : ∀ (P : Prog Q α) (M : Model Q), expose_names simp_all [time, liftProgIntoTime, interpretQueryIntoTime] +end TimeM + section ProgExamples inductive Arith (α : Type) : Type → Type where @@ -172,7 +179,7 @@ inductive Arith (α : Type) : Type → Type where | zero : Arith α α | one : Arith α α -def RatArithQuery : Model (Arith ℚ) where +def RatArithQuery_NatCost : Model (Arith ℚ) ℕ where evalQuery q := match q with | .add x y => x + y @@ -182,21 +189,45 @@ def RatArithQuery : Model (Arith ℚ) where | .one => (1 : ℚ) cost _ := 1 -open Arith +structure AddMulCosts where + addCount : ℕ + mulCount : ℕ +instance : Zero (AddMulCosts) where + zero := ⟨0,0⟩ +instance : Add (AddMulCosts) where + add x y := + let ⟨x_addcount, x_mulcount⟩ := x + let ⟨y_addcount, y_mulcount⟩ := y + ⟨x_addcount + y_addcount, x_mulcount + y_mulcount⟩ -def ex1 [Coe (Arith ℚ ℚ) (Prog (Arith ℚ) ℚ)] : Prog (Arith ℚ) ℚ := do - let mut x ← zero - let mut y ← Coe.coe one - let z ← Coe.coe (add (x + y + y) y) - let w ← Coe.coe <| neg <| ←(Coe.coe <| add z y) - Coe.coe <| add w z +def RatArithQuery_AddMulCost : Model (Arith ℚ) AddMulCosts where + evalQuery q := + match q with + | .add x y => x + y + | .mul x y => x * y + | .neg x => -x + | .zero => (0 : ℚ) + | .one => (1 : ℚ) + cost q := + match q with + | .add _ _ => ⟨1,0⟩ + | .mul _ _ => ⟨0,1⟩ + | _ => 0 -#eval ex1.eval RatArithQuery +open Arith in +def ex1 : Prog (Arith ℚ) ℚ := do + let mut x : ℚ ← @zero ℚ + let mut y ← @one ℚ + let z ← (add (x + y + y) y) + let w ← @neg ℚ (←(add z y)) + add w z -#eval ex1.time RatArithQuery +#eval ex1.eval RatArithQuery_NatCost +#eval ex1.time RatArithQuery_NatCost +#eval ex1.time RatArithQuery_AddMulCost section ArraySort /-- @@ -209,7 +240,7 @@ inductive VecSortOps (α : Type) : Type → Type where | read : (a : Vector α n) → (i : Fin n) → VecSortOps α α | push : (a : Vector α n) → (elem : α) → VecSortOps α (Vector α (n + 1)) -def VecSort_WorstCase [DecidableEq α] : Model (VecSortOps α) where +def VecSort_WorstCase [DecidableEq α] : Model (VecSortOps α) ℕ where evalQuery q := match q with | .write v i x => v.set i x From 734747c70c441b74e2a77edce65dffaca9d0ce8c Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 23 Jan 2026 00:33:03 +0100 Subject: [PATCH 026/176] Comment out mergesort.lean for now --- Cslib/Algorithms/MergeSort/MergeSort.lean | 38 +++++++++++------------ Cslib/Algorithms/QueryModel.lean | 20 +++++++----- 2 files changed, 32 insertions(+), 26 deletions(-) diff --git a/Cslib/Algorithms/MergeSort/MergeSort.lean b/Cslib/Algorithms/MergeSort/MergeSort.lean index d0029094a..0c4b97ddc 100644 --- a/Cslib/Algorithms/MergeSort/MergeSort.lean +++ b/Cslib/Algorithms/MergeSort/MergeSort.lean @@ -30,25 +30,25 @@ open Cslib namespace Cslib.Algorithms.MergeSort.QueryBased -/-- The Model for comparison sorting natural-number registers. --/ -inductive ListSortOps (α : Type) : Type → Type where - | cmp : (l : List α) → (i j : Fin l.length) → ListSortOps α Bool - | write : (l : List α) → (i : Fin l.length) → (x : α) → ListSortOps α (List α) - | read : (l : List α) → (i : Fin l.length) → ListSortOps α α - - -def ListSort_WorstCase [DecidableEq α] : Model (ListSortOps α) where - evalQuery q := - match q with - | .write l i x => l.set i x - | .cmp l i j => l[i] == l[j] - | .read l i => l.get i - cost q := - match q with - | .write l i x => l.length - | .read l i => l.length - | .cmp l i j => l.length +-- /-- The Model for comparison sorting natural-number registers. +-- -/ +-- inductive ListSortOps (α : Type) : Type → Type where +-- | cmp : (l : List α) → (i j : Fin l.length) → ListSortOps α Bool +-- | write : (l : List α) → (i : Fin l.length) → (x : α) → ListSortOps α (List α) +-- | read : (l : List α) → (i : Fin l.length) → ListSortOps α α + + +-- def ListSort_WorstCase [DecidableEq α] : Model (ListSortOps α) where +-- evalQuery q := +-- match q with +-- | .write l i x => l.set i x +-- | .cmp l i j => l[i] == l[j] +-- | .read l i => l.get i +-- cost q := +-- match q with +-- | .write l i x => l.length +-- | .read l i => l.length +-- | .cmp l i j => l.length diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index a03abcfd6..4c08cb34a 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -37,7 +37,7 @@ namespace Cslib namespace Algorithms -class Model (QType : Type u → Type u) (Cost : Type) [Add Cost] [Zero Cost] where +class Model (QType : Type u → Type u) (Cost : Type) [AddMonoid Cost] where evalQuery : QType ι → ι cost : QType ι → Cost @@ -127,7 +127,7 @@ instance {Q α} : Coe (Q α) (FreeM Q α) where namespace Prog -def eval [Add Cost] [Zero Cost] +def eval [AddMonoid Cost] (P : Prog Q α) (M : Model Q Cost) : α := match P with | .pure x => x @@ -135,7 +135,7 @@ def eval [Add Cost] [Zero Cost] let qval := M.evalQuery op eval (cont qval) M -def time [Add Cost] [Zero Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := +def time [AddMonoid Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := match P with | .pure _ => 0 | .liftBind op cont => @@ -193,14 +193,20 @@ structure AddMulCosts where addCount : ℕ mulCount : ℕ -instance : Zero (AddMulCosts) where - zero := ⟨0,0⟩ -instance : Add (AddMulCosts) where - add x y := + +instance iAMC : AddMonoid (AddMulCosts) where + add x y := let ⟨x_addcount, x_mulcount⟩ := x let ⟨y_addcount, y_mulcount⟩ := y ⟨x_addcount + y_addcount, x_mulcount + y_mulcount⟩ + zero := ⟨0,0⟩ + zero_add := by + intro ⟨a₀,a₁⟩ + simp [self.add] + add_assoc := by + intro ⟨a₀,a₁⟩ ⟨b₀,b₁⟩ ⟨c₀,c₁⟩ + def RatArithQuery_AddMulCost : Model (Arith ℚ) AddMulCosts where evalQuery q := From e77ef9bffdb83bb83bae5cf98bc26a05650c28f7 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 23 Jan 2026 00:34:01 +0100 Subject: [PATCH 027/176] Comment out mergesort.lean for now --- Cslib/Algorithms/MergeSort/MergeSort.lean | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Cslib/Algorithms/MergeSort/MergeSort.lean b/Cslib/Algorithms/MergeSort/MergeSort.lean index 0c4b97ddc..3321ee2d7 100644 --- a/Cslib/Algorithms/MergeSort/MergeSort.lean +++ b/Cslib/Algorithms/MergeSort/MergeSort.lean @@ -6,7 +6,6 @@ Authors: Tanner Duve module -public import Cslib.Algorithms.QueryModel @[expose] public section @@ -25,7 +24,7 @@ This file implements merge sort as a program in the query model defined in We also provide simple example evaluations of `mergeSort` and its time cost. -/ -open Cslib + namespace Cslib.Algorithms.MergeSort.QueryBased From e831672f8bb64807db64ae4d287ff98854237a0b Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 23 Jan 2026 00:35:27 +0100 Subject: [PATCH 028/176] Comment out mergesort.lean for now --- Cslib/Algorithms/QueryModel.lean | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 4c08cb34a..a03abcfd6 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -37,7 +37,7 @@ namespace Cslib namespace Algorithms -class Model (QType : Type u → Type u) (Cost : Type) [AddMonoid Cost] where +class Model (QType : Type u → Type u) (Cost : Type) [Add Cost] [Zero Cost] where evalQuery : QType ι → ι cost : QType ι → Cost @@ -127,7 +127,7 @@ instance {Q α} : Coe (Q α) (FreeM Q α) where namespace Prog -def eval [AddMonoid Cost] +def eval [Add Cost] [Zero Cost] (P : Prog Q α) (M : Model Q Cost) : α := match P with | .pure x => x @@ -135,7 +135,7 @@ def eval [AddMonoid Cost] let qval := M.evalQuery op eval (cont qval) M -def time [AddMonoid Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := +def time [Add Cost] [Zero Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := match P with | .pure _ => 0 | .liftBind op cont => @@ -193,20 +193,14 @@ structure AddMulCosts where addCount : ℕ mulCount : ℕ +instance : Zero (AddMulCosts) where + zero := ⟨0,0⟩ - -instance iAMC : AddMonoid (AddMulCosts) where - add x y := +instance : Add (AddMulCosts) where + add x y := let ⟨x_addcount, x_mulcount⟩ := x let ⟨y_addcount, y_mulcount⟩ := y ⟨x_addcount + y_addcount, x_mulcount + y_mulcount⟩ - zero := ⟨0,0⟩ - zero_add := by - intro ⟨a₀,a₁⟩ - simp [self.add] - add_assoc := by - intro ⟨a₀,a₁⟩ ⟨b₀,b₁⟩ ⟨c₀,c₁⟩ - def RatArithQuery_AddMulCost : Model (Arith ℚ) AddMulCosts where evalQuery q := From 68bdf55ada2c799f53dcf1845efc23f2918244c9 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 23 Jan 2026 00:43:08 +0100 Subject: [PATCH 029/176] Comment out mergesort.lean for now --- Cslib/Algorithms/QueryModel.lean | 44 +++++++++++++++++--------------- 1 file changed, 23 insertions(+), 21 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index a03abcfd6..43dc8ebe8 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -257,31 +257,33 @@ def VecSort_WorstCase [DecidableEq α] : Model (VecSortOps α) ℕ where | .swap l i j => 1 | .push a elem => 2 -- amortized over array insertion and resizing by doubling -def swap [LinearOrder α] - (v : Vector α n) (i j : Fin n) : Prog (VecSortOps α) (Vector α n) := - FreeM.lift <| VecSortOps.swap v i j - -def cmp [LinearOrder α] - (v : Vector α n) (i j : Fin n) : Prog (VecSortOps α) Bool := - FreeM.lift <| VecSortOps.cmp v i j - -def write [LinearOrder α] - (v : Vector α n) (i : Fin n) (x : α) : Prog (VecSortOps α) (Vector α n) := - FreeM.lift <| VecSortOps.write v i x +def VecSort_CmpSwap [DecidableEq α] : Model (VecSortOps α) ℕ where + evalQuery q := + match q with + | .write v i x => v.set i x + | .cmp l i j => l[i] == l[j] + | .read l i => l[i] + | .swap l i j => l.swap i j + | .push a elem => a.push elem -def read [LinearOrder α] - (v : Vector α n) (i : Fin n) : Prog (VecSortOps α) α := - FreeM.lift <| VecSortOps.read v i + cost q := + match q with + | .cmp l i j => 1 + | .swap l i j => 1 + | _ => 0 +open VecSortOps in def simpleExample (v : Vector ℤ n) (i k : Fin n) - : Prog (VecSortOps ℤ) (Vector ℤ n) := do - let b ← write v i 10 - _ ← swap b i k - swap v k i - -#eval (simpleExample #v[1,2,3,4,5] 0 2).eval VecSort_WorstCase -#eval (simpleExample #v[1,2,3,4,5] 0 2).time VecSort_WorstCase + : 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 + +#eval (simpleExample #v[1,2,3,4,5] 5 2).eval VecSort_WorstCase +#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_WorstCase +#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_CmpSwap end ArraySort From 93dae2c3e4dd38048b017590474953e87ba1298d Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 23 Jan 2026 00:52:19 +0100 Subject: [PATCH 030/176] Try removing #evals to check build --- Cslib/Algorithms/QueryModel.lean | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 43dc8ebe8..bfef9ed7e 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -225,9 +225,9 @@ def ex1 : Prog (Arith ℚ) ℚ := do add w z -#eval ex1.eval RatArithQuery_NatCost -#eval ex1.time RatArithQuery_NatCost -#eval ex1.time RatArithQuery_AddMulCost +--#eval ex1.eval RatArithQuery_NatCost +--#eval ex1.time RatArithQuery_NatCost +--#eval ex1.time RatArithQuery_AddMulCost section ArraySort /-- From 9ef8f162d4f99e775e9544f7fd95dea04baefa69 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 23 Jan 2026 00:59:37 +0100 Subject: [PATCH 031/176] remove #evals --- Cslib/Algorithms/QueryModel.lean | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index bfef9ed7e..361949fa7 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -281,9 +281,9 @@ def simpleExample (v : Vector ℤ n) (i k : Fin n) let elem ← read c i push c elem -#eval (simpleExample #v[1,2,3,4,5] 5 2).eval VecSort_WorstCase -#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_WorstCase -#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_CmpSwap +--#eval (simpleExample #v[1,2,3,4,5] 5 2).eval VecSort_WorstCase +--#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_WorstCase +--#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_CmpSwap end ArraySort From b7a95d57dd73dc7a98aa2473fb2accdff4de2003 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 23 Jan 2026 01:13:07 +0100 Subject: [PATCH 032/176] Model is a structure now --- Cslib/Algorithms/QueryModel.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 361949fa7..0303fce9a 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -37,7 +37,7 @@ namespace Cslib namespace Algorithms -class Model (QType : Type u → Type u) (Cost : Type) [Add Cost] [Zero Cost] where +structure Model (QType : Type u → Type u) (Cost : Type) [Add Cost] [Zero Cost] where evalQuery : QType ι → ι cost : QType ι → Cost From 8973608e6aa2a3582aac30b51b840118052a8597 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 23 Jan 2026 01:14:08 +0100 Subject: [PATCH 033/176] Remove redundant TimeM interpretation in the beginning. The TimeM section suffices --- Cslib/Algorithms/QueryModel.lean | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 0303fce9a..03e536db2 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -43,18 +43,7 @@ structure Model (QType : Type u → Type u) (Cost : Type) [Add Cost] [Zero Cost] namespace Model -def interpretTimeM - (M : Model Q ℕ) (q : Q ι) : TimeM ι where - ret := M.evalQuery q - time := M.cost q --- inductive QueryF : Type → Type where --- /-- Read the value stored at index `i`. -/ --- | read : Nat → QueryF Nat --- /-- Write value `v` at index `i`. -/ --- | write : Nat → Nat → QueryF PUnit --- /-- Compare the values at indices `i` and `j`. -/ --- | cmp : Nat → Nat → QueryF Bool section Examples From e4407cc849a7e93ab9bfea659a71d10fa3bd0074 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 23 Jan 2026 01:27:14 +0100 Subject: [PATCH 034/176] Cslib.Init imports --- Cslib/Algorithms/Lean/MergeSort/MergeSort.lean | 1 + Cslib/Algorithms/QueryModel.lean | 4 ---- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean b/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean index c154a1083..d5d08717c 100644 --- a/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean +++ b/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean @@ -6,6 +6,7 @@ Authors: Sorrachai Yingchareonthawornhcai module +public import Cslib.Init public import Cslib.Algorithms.Lean.TimeM public import Mathlib.Data.Nat.Cast.Order.Ring public import Mathlib.Data.Nat.Lattice diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 03e536db2..370c24b28 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -19,10 +19,6 @@ public import Batteries This file defines a simple query language modeled as a free monad over a parametric type of query operations. -We equip this language with a cost model (`TimeM`) that counts how many primitive queries -are performed. An example algorithm (merge sort) is implemented in -`Cslib.Algorithms.MergeSort.QueryBased`. - ## Main definitions - `QueryF`, `Prog` : query language and programs From c59aa5d92a4399a5c3b17cd67c34fb9ebaef0498 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 23 Jan 2026 02:49:03 +0100 Subject: [PATCH 035/176] Set up linear search example. Only theorem statements. Proofs come later --- Cslib/Algorithms/QueryModel.lean | 55 ++++++++++++++++++++++++++++---- 1 file changed, 49 insertions(+), 6 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 370c24b28..28c56e798 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -97,13 +97,8 @@ def Array_BinSearch_WorstCase [BEq α] : Model (ArrayOps α) ℕ where end Examples -end Model --- ALternative def where pure has to be a query --- /-- Programs built as the free ~~monad~~ arrow? over `QueryF`. -/ --- inductive Prog (Q : Type u → Type u) : Type u → Type (u + 1) where --- | pure (q : Q α) : Prog Q α --- | seq (p₁ : Prog Q ι) (cont : ι → Prog Q α) : Prog Q α +end Model abbrev Prog Q α := FreeM Q α @@ -272,6 +267,54 @@ def simpleExample (v : Vector ℤ n) (i k : Fin n) end ArraySort +section VectorLinearSearch + +inductive VecSearch (α : Type) : Type → Type where + | compare : (a : Vector α n) → (i : ℕ) → (val : α) → VecSearch α Bool + + +def VecSearch_Nat [DecidableEq α] : Model (VecSearch α) ℕ where + evalQuery q := + match q with + | .compare l i x => l[i]? == some x + cost q := + match q with + | .compare _ _ _ => 1 + + +open VecSearch in +def linearSearch (v : Vector α n) (x : α) : Prog (VecSearch α) Bool := do + let mut comp_res : Bool := false + for i in [0:n] do + comp_res ← compare v i x + if comp_res == true then + break + else + continue + return comp_res + +#eval (linearSearch #v[12,23,31,42,52,4,6] 4).eval VecSearch_Nat +#eval (linearSearch #v[1,2,3,4,5,6] 7).eval VecSearch_Nat + +#eval (linearSearch #v[1,2,3,22, 11, 12, 4,5,6] 4).time VecSearch_Nat +#eval (linearSearch #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Nat + +lemma linearSearch_correct_true [DecidableEq α] (v : Vector α n) : + ∀ x : α, x ∈ v → (linearSearch v x).eval VecSearch_Nat = true := by + intro x x_mem_v + sorry + +lemma linearSearch_correct_false [DecidableEq α] (v : Vector α n) : + ∀ x : α, x ∉ v → (linearSearch v x).eval VecSearch_Nat = false := by + intro x x_mem_v + sorry + +lemma linearSearch_time_complexity [DecidableEq α] (v : Vector α n) : + ∀ x : α, (linearSearch v x).time VecSearch_Nat ≤ n := by + intro x + sorry + +end VectorLinearSearch end ProgExamples From 903f5e4b42c87ea60f82c11952e6d66721b2986a Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 23 Jan 2026 02:55:52 +0100 Subject: [PATCH 036/176] extra space removed --- Cslib/Algorithms/QueryModel.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 28c56e798..4d83d6e70 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -285,7 +285,7 @@ def VecSearch_Nat [DecidableEq α] : Model (VecSearch α) ℕ where open VecSearch in def linearSearch (v : Vector α n) (x : α) : Prog (VecSearch α) Bool := do let mut comp_res : Bool := false - for i in [0:n] do + for i in [0:n] do comp_res ← compare v i x if comp_res == true then break From b8e89df63ef5be26c5f862a076864f05f20646f9 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 23 Jan 2026 13:55:27 +0100 Subject: [PATCH 037/176] Let's tail-recursive linear search. It is still monadic --- Cslib/Algorithms/QueryModel.lean | 111 ++++++++++++++++++++++++++++--- 1 file changed, 100 insertions(+), 11 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 4d83d6e70..8372289e4 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -281,9 +281,98 @@ def VecSearch_Nat [DecidableEq α] : Model (VecSearch α) ℕ where match q with | .compare _ _ _ => 1 +structure CmpCount where + cmp : ℕ + +instance : Add (CmpCount) where + add x y := ⟨x.1 + y.1⟩ + +instance : Zero (CmpCount) where + zero := ⟨0⟩ + +def VecSearch_Cmp [DecidableEq α] : Model (VecSearch α) CmpCount where + evalQuery q := + match q with + | .compare l i x => l[i]? == some x + cost q := + match q with + | .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 := do +def linearSearch (v : Vector α n) (x : α) : Prog (VecSearch α) Bool:= + linearSearchAux v x false 0 + +#eval (linearSearch #v[12,23,31,42,52,4,6] 4).eval VecSearch_Nat +#eval (linearSearch #v[1,2,3,4,5,6] 7).eval VecSearch_Cmp + +#eval (linearSearch #v[1,2,3,22, 11, 12, 4,5,6] 4).time VecSearch_Nat +#eval (linearSearch #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Cmp + + +lemma linearSearch_correct_true [DecidableEq α] (v : Vector α n) + (hn_pos : n > 0): + ∀ x : α, x ∈ v → (linearSearch v x).eval VecSearch_Nat = true := by + intro x x_mem_v + simp [linearSearch] + unfold linearSearchAux + split_ifs with h_geq_n + · simp_all + · unfold eval + split + · expose_names + simp_all + done + · expose_names + simp_all [VecSearch_Nat] + done + +lemma linearSearch_correct_false [DecidableEq α] (v : Vector α n) : + ∀ x : α, x ∉ v → (linearSearch v x).eval VecSearch_Nat = false := by + intro x x_mem_v + simp [linearSearch] + unfold linearSearchAux + split_ifs with h_geq_n + · simp_all [eval] + · unfold eval + split + · expose_names + simp_all + done + · expose_names + simp_all + have ⟨hι, hop, hcont⟩ := heq + done + +lemma linearSearch_time_complexity [DecidableEq α] (v : Vector α n) : + ∀ x : α, (linearSearch v x).time VecSearch_Nat ≤ n := by + intro x + simp only [linearSearch, VecSearch_Nat] + unfold linearSearchAux + split_ifs with h + · simp_all [time] + · simp_all [time] + split_ifs with hfound + · simp_all[time] + exact Nat.one_le_iff_ne_zero.mpr h + · simp_wf + + done + +-- The Monadic version +open VecSearch in +def linearSearchM (v : Vector α n) (x : α) : Prog (VecSearch α) Bool := do let mut comp_res : Bool := false for i in [0:n] do comp_res ← compare v i x @@ -293,24 +382,24 @@ def linearSearch (v : Vector α n) (x : α) : Prog (VecSearch α) Bool := do continue return comp_res -#eval (linearSearch #v[12,23,31,42,52,4,6] 4).eval VecSearch_Nat -#eval (linearSearch #v[1,2,3,4,5,6] 7).eval VecSearch_Nat +#eval (linearSearchM #v[12,23,31,42,52,4,6] 4).eval VecSearch_Nat +#eval (linearSearchM #v[1,2,3,4,5,6] 7).eval VecSearch_Nat -#eval (linearSearch #v[1,2,3,22, 11, 12, 4,5,6] 4).time VecSearch_Nat -#eval (linearSearch #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Nat +#eval (linearSearchM #v[1,2,3,22, 11, 12, 4,5,6] 4).time VecSearch_Nat +#eval (linearSearchM #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Nat -lemma linearSearch_correct_true [DecidableEq α] (v : Vector α n) : - ∀ x : α, x ∈ v → (linearSearch v x).eval VecSearch_Nat = true := by +lemma linearSearchM_correct_true [DecidableEq α] (v : Vector α n) : + ∀ x : α, x ∈ v → (linearSearchM v x).eval VecSearch_Nat = true := by intro x x_mem_v sorry -lemma linearSearch_correct_false [DecidableEq α] (v : Vector α n) : - ∀ x : α, x ∉ v → (linearSearch v x).eval VecSearch_Nat = false := by +lemma linearSearchM_correct_false [DecidableEq α] (v : Vector α n) : + ∀ x : α, x ∉ v → (linearSearchM v x).eval VecSearch_Nat = false := by intro x x_mem_v sorry -lemma linearSearch_time_complexity [DecidableEq α] (v : Vector α n) : - ∀ x : α, (linearSearch v x).time VecSearch_Nat ≤ n := by +lemma linearSearchM_time_complexity [DecidableEq α] (v : Vector α n) : + ∀ x : α, (linearSearchM v x).time VecSearch_Nat ≤ n := by intro x sorry From d7fa83e9cb191100df1df340c469e849f3d61596 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 23 Jan 2026 18:14:40 +0100 Subject: [PATCH 038/176] Author and license stuff --- Cslib/Algorithms/QueryModel.lean | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 8372289e4..59e37ecd4 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2025 Tanner Duve. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Tanner Duve +Authors: Tanner Duve, Shreyas Srinivas -/ module @@ -336,6 +336,7 @@ lemma linearSearch_correct_true [DecidableEq α] (v : Vector α n) done · expose_names simp_all [VecSearch_Nat] + have ⟨hι, hop, hcont⟩ := heq done lemma linearSearch_correct_false [DecidableEq α] (v : Vector α n) : @@ -353,6 +354,8 @@ lemma linearSearch_correct_false [DecidableEq α] (v : Vector α n) : · expose_names simp_all have ⟨hι, hop, hcont⟩ := heq + unfold eval + done lemma linearSearch_time_complexity [DecidableEq α] (v : Vector α n) : @@ -366,8 +369,7 @@ lemma linearSearch_time_complexity [DecidableEq α] (v : Vector α n) : split_ifs with hfound · simp_all[time] exact Nat.one_le_iff_ne_zero.mpr h - · simp_wf - + · done -- The Monadic version From c1061d32e372bf8df35358863c4f56aa0581db20 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 24 Jan 2026 02:32:55 +0100 Subject: [PATCH 039/176] Another attempt at proofs --- Cslib/Algorithms/QueryModel.lean | 71 ++++++++++++++------------------ 1 file changed, 32 insertions(+), 39 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 59e37ecd4..f3ab44b46 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -261,9 +261,9 @@ def simpleExample (v : Vector ℤ n) (i k : Fin n) let elem ← read c i push c elem ---#eval (simpleExample #v[1,2,3,4,5] 5 2).eval VecSort_WorstCase ---#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_WorstCase ---#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_CmpSwap +#eval (simpleExample #v[1,2,3,4,5] 5 2).eval VecSort_WorstCase +#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_WorstCase +#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_CmpSwap end ArraySort @@ -325,52 +325,45 @@ lemma linearSearch_correct_true [DecidableEq α] (v : Vector α n) (hn_pos : n > 0): ∀ x : α, x ∈ v → (linearSearch v x).eval VecSearch_Nat = true := by intro x x_mem_v - simp [linearSearch] - unfold linearSearchAux - split_ifs with h_geq_n - · simp_all - · unfold eval - split - · expose_names + simp only [linearSearch] + induction n with + | zero => simp_all - done - · expose_names - simp_all [VecSearch_Nat] - have ⟨hι, hop, hcont⟩ := heq - done + | succ n ih => + simp_all only [gt_iff_lt, lt_add_iff_pos_left, add_pos_iff, zero_lt_one, or_true] + unfold linearSearchAux + split_ifs with h_cond + · simp_all + · unfold eval + simp_all + split_ifs with h_find + · simp [eval] + · sorry lemma linearSearch_correct_false [DecidableEq α] (v : Vector α n) : ∀ x : α, x ∉ v → (linearSearch v x).eval VecSearch_Nat = false := by intro x x_mem_v - simp [linearSearch] - unfold linearSearchAux - split_ifs with h_geq_n - · simp_all [eval] - · unfold eval - split - · expose_names - simp_all - done - · expose_names - simp_all - have ⟨hι, hop, hcont⟩ := heq - unfold eval - - done + simp only [linearSearch] + induction n with + | zero => + simp_all [VecSearch_Nat] + sorry + | succ n ih => + sorry lemma linearSearch_time_complexity [DecidableEq α] (v : Vector α n) : ∀ x : α, (linearSearch v x).time VecSearch_Nat ≤ n := by intro x simp only [linearSearch, VecSearch_Nat] - unfold linearSearchAux - split_ifs with h - · simp_all [time] - · simp_all [time] - split_ifs with hfound - · simp_all[time] - exact Nat.one_le_iff_ne_zero.mpr h - · - done + induction n with + | zero => + simp_all [linearSearchAux, time] + | succ n ih => + unfold linearSearchAux + split_ifs with h_cond + · simp_all + · simp [time] + sorry -- The Monadic version open VecSearch in From 25353362259d4d873571063c61f18c1483fc67e1 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 24 Jan 2026 12:02:19 +0100 Subject: [PATCH 040/176] Let's count pure oerations as well --- Cslib/Algorithms/QueryModel.lean | 60 ++++++++++++++++++-------------- 1 file changed, 34 insertions(+), 26 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index f3ab44b46..ef93016f7 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -33,7 +33,7 @@ namespace Cslib namespace Algorithms -structure Model (QType : Type u → Type u) (Cost : Type) [Add Cost] [Zero Cost] where +structure Model (QType : Type u → Type u) (Cost : Type) [Add Cost] [Zero Cost] [One Cost] where evalQuery : QType ι → ι cost : QType ι → Cost @@ -107,7 +107,7 @@ instance {Q α} : Coe (Q α) (FreeM Q α) where namespace Prog -def eval [Add Cost] [Zero Cost] +def eval [Add Cost] [Zero Cost] [One Cost] (P : Prog Q α) (M : Model Q Cost) : α := match P with | .pure x => x @@ -115,9 +115,9 @@ def eval [Add Cost] [Zero Cost] let qval := M.evalQuery op eval (cont qval) M -def time [Add Cost] [Zero Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := +def time [Add Cost] [Zero Cost] [One Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := match P with - | .pure _ => 0 + | .pure _ => 1 | .liftBind op cont => let t₁ := M.cost op let qval := M.evalQuery op @@ -137,16 +137,16 @@ def liftProgIntoTime (M : Model Q ℕ) (P : Prog Q α) : TimeM α := P.liftM (interpretQueryIntoTime M) --- This lemma is a sanity check. This is the only place `TimeM` is used. -lemma timing_is_identical : ∀ (P : Prog Q α) (M : Model Q ℕ), - time P M = (liftProgIntoTime M P).time := by - intro P pm - induction P with - | pure a => - simp [time,liftProgIntoTime] - | liftBind op cont ih => - expose_names - simp_all [time, liftProgIntoTime, interpretQueryIntoTime] +-- -- This lemma is a sanity check. This is the only place `TimeM` is used. +-- lemma timing_is_identical : ∀ (P : Prog Q α) (M : Model Q ℕ), +-- time P M = (liftProgIntoTime M P).time := by +-- intro P pm +-- induction P with +-- | pure a => +-- simp [time,liftProgIntoTime] +-- | liftBind op cont ih => +-- expose_names +-- simp_all [time, liftProgIntoTime, interpretQueryIntoTime] end TimeM @@ -172,15 +172,19 @@ def RatArithQuery_NatCost : Model (Arith ℚ) ℕ where structure AddMulCosts where addCount : ℕ mulCount : ℕ + pure : ℕ instance : Zero (AddMulCosts) where - zero := ⟨0,0⟩ + zero := ⟨0,0,0⟩ + +instance : One (AddMulCosts) where + one := ⟨0,0,1⟩ instance : Add (AddMulCosts) where add x y := - let ⟨x_addcount, x_mulcount⟩ := x - let ⟨y_addcount, y_mulcount⟩ := y - ⟨x_addcount + y_addcount, x_mulcount + y_mulcount⟩ + let ⟨x_addcount, x_mulcount, x_pure⟩ := x + let ⟨y_addcount, y_mulcount, y_pure⟩ := y + ⟨x_addcount + y_addcount, x_mulcount + y_mulcount, x_pure + y_pure⟩ def RatArithQuery_AddMulCost : Model (Arith ℚ) AddMulCosts where evalQuery q := @@ -192,8 +196,8 @@ def RatArithQuery_AddMulCost : Model (Arith ℚ) AddMulCosts where | .one => (1 : ℚ) cost q := match q with - | .add _ _ => ⟨1,0⟩ - | .mul _ _ => ⟨0,1⟩ + | .add _ _ => ⟨1,0,0⟩ + | .mul _ _ => ⟨0,1,0⟩ | _ => 0 open Arith in @@ -205,9 +209,9 @@ def ex1 : Prog (Arith ℚ) ℚ := do add w z ---#eval ex1.eval RatArithQuery_NatCost ---#eval ex1.time RatArithQuery_NatCost ---#eval ex1.time RatArithQuery_AddMulCost +#eval ex1.eval RatArithQuery_NatCost +#eval ex1.time RatArithQuery_NatCost +#eval ex1.time RatArithQuery_AddMulCost section ArraySort /-- @@ -283,12 +287,16 @@ def VecSearch_Nat [DecidableEq α] : Model (VecSearch α) ℕ where structure CmpCount where cmp : ℕ + pure : ℕ instance : Add (CmpCount) where - add x y := ⟨x.1 + y.1⟩ + add x y := ⟨x.1 + y.1, x.2 + y.2⟩ instance : Zero (CmpCount) where - zero := ⟨0⟩ + zero := ⟨0,0⟩ + +instance : One (CmpCount) where + one := ⟨0,1⟩ def VecSearch_Cmp [DecidableEq α] : Model (VecSearch α) CmpCount where evalQuery q := @@ -296,7 +304,7 @@ def VecSearch_Cmp [DecidableEq α] : Model (VecSearch α) CmpCount where | .compare l i x => l[i]? == some x cost q := match q with - | .compare _ _ _ => ⟨1⟩ + | .compare _ _ _ => ⟨1,0⟩ open VecSearch in def linearSearchAux (v : Vector α n) From fb185b95c47e10705e62b4a4fdc53040a4e81d3b Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 24 Jan 2026 12:08:37 +0100 Subject: [PATCH 041/176] Let's count pure oerations as well --- Cslib/Algorithms/QueryModel.lean | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index ef93016f7..b4cc569f4 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -33,7 +33,14 @@ namespace Cslib namespace Algorithms -structure Model (QType : Type u → Type u) (Cost : Type) [Add Cost] [Zero Cost] [One Cost] where +class PureCosts (α : Type u) where + pureCost : α + +instance : PureCosts ℕ where + pureCost := 1 + +structure Model (QType : Type u → Type u) (Cost : Type) [Add Cost] [Zero Cost] + [PureCosts Cost] where evalQuery : QType ι → ι cost : QType ι → Cost @@ -107,7 +114,7 @@ instance {Q α} : Coe (Q α) (FreeM Q α) where namespace Prog -def eval [Add Cost] [Zero Cost] [One Cost] +def eval [Add Cost] [Zero Cost] [PureCosts Cost] (P : Prog Q α) (M : Model Q Cost) : α := match P with | .pure x => x @@ -115,9 +122,10 @@ def eval [Add Cost] [Zero Cost] [One Cost] let qval := M.evalQuery op eval (cont qval) M -def time [Add Cost] [Zero Cost] [One Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := +def time [Add Cost] [Zero Cost] [PureCosts Cost] + (P : Prog Q α) (M : Model Q Cost) : Cost := match P with - | .pure _ => 1 + | .pure _ => PureCosts.pureCost | .liftBind op cont => let t₁ := M.cost op let qval := M.evalQuery op @@ -177,8 +185,8 @@ structure AddMulCosts where instance : Zero (AddMulCosts) where zero := ⟨0,0,0⟩ -instance : One (AddMulCosts) where - one := ⟨0,0,1⟩ +instance : PureCosts (AddMulCosts) where + pureCost := ⟨0,0,1⟩ instance : Add (AddMulCosts) where add x y := @@ -295,8 +303,8 @@ instance : Add (CmpCount) where instance : Zero (CmpCount) where zero := ⟨0,0⟩ -instance : One (CmpCount) where - one := ⟨0,1⟩ +instance : PureCosts (CmpCount) where + pureCost := ⟨0,1⟩ def VecSearch_Cmp [DecidableEq α] : Model (VecSearch α) CmpCount where evalQuery q := @@ -360,12 +368,12 @@ lemma linearSearch_correct_false [DecidableEq α] (v : Vector α n) : sorry lemma linearSearch_time_complexity [DecidableEq α] (v : Vector α n) : - ∀ x : α, (linearSearch v x).time VecSearch_Nat ≤ n := by + ∀ x : α, (linearSearch v x).time VecSearch_Nat ≤ n + 1 := by intro x simp only [linearSearch, VecSearch_Nat] induction n with | zero => - simp_all [linearSearchAux, time] + simp_all [linearSearchAux, time, PureCosts.pureCost] | succ n ih => unfold linearSearchAux split_ifs with h_cond From 3bf4db0f99baadc6ebc7386ba5e6d823eae30bea Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 24 Jan 2026 12:24:08 +0100 Subject: [PATCH 042/176] Add missing public annotation to import in CSLib --- Cslib.lean | 2 +- Cslib/Algorithms/QueryModel.lean | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/Cslib.lean b/Cslib.lean index 419d2e3a1..f19f812e7 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -31,7 +31,7 @@ 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.Control.Monad.Time -import Cslib.Foundations.Data.FinFun +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 diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index b4cc569f4..b3f1c80cc 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -398,6 +398,7 @@ def linearSearchM (v : Vector α n) (x : α) : Prog (VecSearch α) Bool := do #eval (linearSearchM #v[1,2,3,22, 11, 12, 4,5,6] 4).time VecSearch_Nat #eval (linearSearchM #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Nat +#eval (linearSearchM #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Cmp lemma linearSearchM_correct_true [DecidableEq α] (v : Vector α n) : ∀ x : α, x ∈ v → (linearSearchM v x).eval VecSearch_Nat = true := by From 5ca8828add6dbc48fd8e00447ba8bb561566081e Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 24 Jan 2026 12:32:03 +0100 Subject: [PATCH 043/176] Address some review comments --- Cslib/Algorithms/QueryModel.lean | 48 +++++++++++++------------------- 1 file changed, 20 insertions(+), 28 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index b3f1c80cc..b0d479fe7 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -51,19 +51,17 @@ namespace Model section Examples inductive ListOps (α : Type) : Type → Type where - | get : (l : List α) → (i : Fin l.length) → ListOps α α - | find : (l : List α) → α → ListOps α ℕ - | write : (l : List α) → (i : Fin l.length) → (x : α) → ListOps α (List α) + | get (l : List α) (i : Fin l.length) : ListOps α α + | find (l : List α) (elem : α) : ListOps α ℕ + | write (l : List α) (i : Fin l.length) (x : α) : ListOps α (List α) def List_LinSearch_WorstCase [DecidableEq α] : Model (ListOps α) ℕ where - evalQuery q := - match q with + evalQuery | .write l i x => l.set i x | .find l elem => l.findIdx (· = elem) | .get l i => l[i] - cost q := - match q with + cost | .write l i x => l.length | .find l elem => l.length | .get l i => l.length @@ -71,14 +69,12 @@ def List_LinSearch_WorstCase [DecidableEq α] : Model (ListOps α) ℕ where def List_BinSearch_WorstCase [BEq α] : Model (ListOps α) ℕ where - evalQuery q := - match q with + evalQuery | .write l i x => l.set i x | .get l i => l[i] | .find l elem => l.findIdx (· == elem) - cost q := - match q with + cost | .find l _ => 1 + Nat.log 2 (l.length) | .write l i x => l.length | .get l x => l.length @@ -89,14 +85,12 @@ inductive ArrayOps (α : Type) : Type → Type where | write : (l : Array α) → (i : Fin l.size) → (x : α) → ArrayOps α (Array α) def Array_BinSearch_WorstCase [BEq α] : Model (ArrayOps α) ℕ where - evalQuery q := - match q with + evalQuery | .write l i x => l.set i x | .get l i => l[i] | .find l elem => l.findIdx (· == elem) - cost q := - match q with + cost | .find l _ => 1 + Nat.log 2 (l.size) | .write l i x => 1 | .get l x => 1 @@ -137,6 +131,7 @@ section TimeM def interpretQueryIntoTime (M : Model Q ℕ) (q : Q α) : TimeM α where ret := M.evalQuery q time := M.cost q + def interpretProgIntoTime (P : Prog Q α) (M : Model Q ℕ) : TimeM α where ret := eval P M time := time P M @@ -145,6 +140,9 @@ def liftProgIntoTime (M : Model Q ℕ) (P : Prog Q α) : TimeM α := P.liftM (interpretQueryIntoTime M) +-- The below lemma only holds if the cost of pure operations is zero. This +-- is however a footgun + -- -- This lemma is a sanity check. This is the only place `TimeM` is used. -- lemma timing_is_identical : ∀ (P : Prog Q α) (M : Model Q ℕ), -- time P M = (liftProgIntoTime M P).time := by @@ -195,15 +193,13 @@ instance : Add (AddMulCosts) where ⟨x_addcount + y_addcount, x_mulcount + y_mulcount, x_pure + y_pure⟩ def RatArithQuery_AddMulCost : Model (Arith ℚ) AddMulCosts where - evalQuery q := - match q with + evalQuery | .add x y => x + y | .mul x y => x * y | .neg x => -x | .zero => (0 : ℚ) | .one => (1 : ℚ) - cost q := - match q with + cost | .add _ _ => ⟨1,0,0⟩ | .mul _ _ => ⟨0,1,0⟩ | _ => 0 @@ -233,16 +229,14 @@ inductive VecSortOps (α : Type) : Type → Type where | push : (a : Vector α n) → (elem : α) → VecSortOps α (Vector α (n + 1)) def VecSort_WorstCase [DecidableEq α] : Model (VecSortOps α) ℕ where - evalQuery q := - match q with + evalQuery | .write v i x => v.set i x | .cmp l i j => l[i] == l[j] | .read l i => l[i] | .swap l i j => l.swap i j | .push a elem => a.push elem - cost q := - match q with + cost | .write l i x => 1 | .read l i => 1 | .cmp l i j => 1 @@ -250,16 +244,14 @@ def VecSort_WorstCase [DecidableEq α] : Model (VecSortOps α) ℕ where | .push a elem => 2 -- amortized over array insertion and resizing by doubling def VecSort_CmpSwap [DecidableEq α] : Model (VecSortOps α) ℕ where - evalQuery q := - match q with + evalQuery | .write v i x => v.set i x | .cmp l i j => l[i] == l[j] | .read l i => l[i] | .swap l i j => l.swap i j | .push a elem => a.push elem - cost q := - match q with + cost | .cmp l i j => 1 | .swap l i j => 1 | _ => 0 @@ -282,7 +274,7 @@ end ArraySort section VectorLinearSearch inductive VecSearch (α : Type) : Type → Type where - | compare : (a : Vector α n) → (i : ℕ) → (val : α) → VecSearch α Bool + | compare (a : Vector α n) (i : ℕ) (val : α) : VecSearch α Bool def VecSearch_Nat [DecidableEq α] : Model (VecSearch α) ℕ where From 22a5af4e8af214997967d9eaf9e382d50981c744 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sun, 25 Jan 2026 03:28:19 +0100 Subject: [PATCH 044/176] List linear search proofs were simpler --- Cslib/Algorithms/QueryModel.lean | 92 +++++++++++++++++++++++++++++++- 1 file changed, 91 insertions(+), 1 deletion(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index b0d479fe7..281ece9aa 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -330,7 +330,7 @@ def linearSearch (v : Vector α n) (x : α) : Prog (VecSearch α) Bool:= lemma linearSearch_correct_true [DecidableEq α] (v : Vector α n) - (hn_pos : n > 0): + (hn_pos : n > 0) : ∀ x : α, x ∈ v → (linearSearch v x).eval VecSearch_Nat = true := by intro x x_mem_v simp only [linearSearch] @@ -409,6 +409,96 @@ lemma linearSearchM_time_complexity [DecidableEq α] (v : Vector α n) : end VectorLinearSearch +section ListLinearSearch +inductive ListSearch (α : Type) : Type → Type where + | compare (a : List α) (val : α) : ListSearch α Bool + + +def ListSearch_Nat [DecidableEq α] : Model (ListSearch α) ℕ where + evalQuery q := + match q with + | .compare l x => l.head? = some x + cost q := + match q with + | .compare _ _ => 1 + + +def ListSearch_Cmp [DecidableEq α] : Model (ListSearch α) CmpCount where + evalQuery q := + match q with + | .compare l x => l.head? == some x + cost q := + match q with + | .compare _ _ => ⟨1,0⟩ + +open ListSearch in +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 + +lemma listLinearSearchM_correct_true [iDec : DecidableEq α] (l : List α) : + ∀ x : α, x ∈ l → (listLinearSearch l x).eval ListSearch_Nat = true := by + intro x x_mem_l + induction l with + | nil => + simp_all only [List.not_mem_nil] + | cons head tail ih => + simp_all only [List.mem_cons, listLinearSearch, bind, FreeM.lift_def, pure, + FreeM.liftBind_bind, FreeM.pure_bind, eval] + split_ifs with h + · simp [eval] + · obtain (x_head | xtail) := x_mem_l + · rw [x_head] at h + simp[ListSearch_Nat] at h + · specialize ih xtail + exact ih + +lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) : + ∀ x : α, x ∉ l → (listLinearSearch l x).eval ListSearch_Nat = false := by + intro x x_mem_l + induction l with + | nil => + simp_all [listLinearSearch, eval] + | cons head tail ih => + simp only [List.mem_cons, not_or] at x_mem_l + specialize ih x_mem_l.2 + simp only [listLinearSearch, bind, FreeM.lift_def, pure, FreeM.liftBind_bind, FreeM.pure_bind, + eval] + split_ifs with h_eq + · simp [ListSearch_Nat] at h_eq + exfalso + exact x_mem_l.1 h_eq.symm + · exact ih + + + +lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List α) : + ∀ x : α, (listLinearSearch l x).time ListSearch_Nat ≤ 1 + l.length := by + intro x + induction l with + | nil => + simp_all [listLinearSearch, ListSearch_Nat, time, PureCosts.pureCost] + | cons head tail ih => + simp_all [listLinearSearch, ListSearch_Nat, time] + split_ifs with h_head + · simp [time, PureCosts.pureCost] + · grind + +lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Nontrivial α] : + ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = 1 + l.length := by + obtain ⟨x, y, x_neq_y⟩ := inon + use [x,x,x,x,x,y], y + simp_all [time, ListSearch_Nat, listLinearSearch, PureCosts.pureCost] + + +end ListLinearSearch + end ProgExamples end Prog From 7ef2750130768cb1a48f47652f3e6dabb0cb8a0c Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sun, 25 Jan 2026 03:38:37 +0100 Subject: [PATCH 045/176] Try Vector proofs by list induction --- Cslib/Algorithms/QueryModel.lean | 30 ++++++++++++++++++++++++++---- 1 file changed, 26 insertions(+), 4 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 281ece9aa..24edb38e5 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -395,17 +395,39 @@ def linearSearchM (v : Vector α n) (x : α) : Prog (VecSearch α) Bool := do lemma linearSearchM_correct_true [DecidableEq α] (v : Vector α n) : ∀ x : α, x ∈ v → (linearSearchM v x).eval VecSearch_Nat = true := by intro x x_mem_v - sorry + induction h : v.toArray.toList with + | nil => + simp_all [linearSearchM, eval] + have v_empty : h ▸ v = #v[] := by + simp + have x_not_mem_v : x ∉ v := by + subst h + aesop + tauto + | cons head tail ih => + sorry + lemma linearSearchM_correct_false [DecidableEq α] (v : Vector α n) : ∀ x : α, x ∉ v → (linearSearchM v x).eval VecSearch_Nat = false := by intro x x_mem_v - sorry + induction h : v.toArray.toList with + | nil => + simp_all [linearSearchM, eval] + | cons head tail ih => + simp_all [linearSearchM] + sorry lemma linearSearchM_time_complexity [DecidableEq α] (v : Vector α n) : - ∀ x : α, (linearSearchM v x).time VecSearch_Nat ≤ n := by + ∀ x : α, (linearSearchM v x).time VecSearch_Nat ≤ n + 1 := by intro x - sorry + induction h : v.toArray.toList with + | nil => + simp_all [linearSearchM, time, PureCosts.pureCost] + | cons head tail ih => + simp_all [linearSearchM, VecSearch_Nat] + sorry + end VectorLinearSearch From 72a74c79ae20ab492ed73d7ebfb823440b4bf619 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sun, 25 Jan 2026 04:15:26 +0100 Subject: [PATCH 046/176] Split the files --- Cslib/Algorithms/ProgExamples.lean | 384 +++++++++++++++++++++++ Cslib/Algorithms/QueryExamples.lean | 72 +++++ Cslib/Algorithms/QueryModel.lean | 459 ++-------------------------- 3 files changed, 487 insertions(+), 428 deletions(-) create mode 100644 Cslib/Algorithms/ProgExamples.lean create mode 100644 Cslib/Algorithms/QueryExamples.lean diff --git a/Cslib/Algorithms/ProgExamples.lean b/Cslib/Algorithms/ProgExamples.lean new file mode 100644 index 000000000..0060203b0 --- /dev/null +++ b/Cslib/Algorithms/ProgExamples.lean @@ -0,0 +1,384 @@ +module + +public import Cslib.Algorithms.QueryModel + +@[expose] public section + +namespace Cslib + +namespace Algorithms + +namespace Prog + +section ProgExamples + +inductive Arith (α : Type) : Type → Type where + | add (x y : α) : Arith α α + | mul (x y : α) : Arith α α + | neg (x : α) : Arith α α + | zero : Arith α α + | one : Arith α α + +def RatArithQuery_NatCost : Model (Arith ℚ) ℕ where + evalQuery q := + match q with + | .add x y => x + y + | .mul x y => x * y + | .neg x => -x + | .zero => (0 : ℚ) + | .one => (1 : ℚ) + cost _ := 1 + +structure AddMulCosts where + addCount : ℕ + mulCount : ℕ + pure : ℕ + +instance : Zero (AddMulCosts) where + zero := ⟨0,0,0⟩ + +instance : PureCosts (AddMulCosts) where + pureCost := ⟨0,0,1⟩ + +instance : Add (AddMulCosts) where + add x y := + let ⟨x_addcount, x_mulcount, x_pure⟩ := x + let ⟨y_addcount, y_mulcount, y_pure⟩ := y + ⟨x_addcount + y_addcount, x_mulcount + y_mulcount, x_pure + y_pure⟩ + +def RatArithQuery_AddMulCost : Model (Arith ℚ) AddMulCosts where + evalQuery + | .add x y => x + y + | .mul x y => x * y + | .neg x => -x + | .zero => (0 : ℚ) + | .one => (1 : ℚ) + cost + | .add _ _ => ⟨1,0,0⟩ + | .mul _ _ => ⟨0,1,0⟩ + | _ => 0 + +open Arith in +def ex1 : Prog (Arith ℚ) ℚ := do + let mut x : ℚ ← @zero ℚ + let mut y ← @one ℚ + let z ← (add (x + y + y) y) + let w ← @neg ℚ (←(add z y)) + add w z + + +#eval ex1.eval RatArithQuery_NatCost +#eval ex1.time RatArithQuery_NatCost +#eval ex1.time RatArithQuery_AddMulCost + +section ArraySort +/-- +The array version of the sort operations +-/ +inductive VecSortOps (α : Type) : Type → Type where + | swap : (a : Vector α n) → (i j : Fin n) → VecSortOps α (Vector α n) + | cmp : (a : Vector α n) → (i j : Fin n) → VecSortOps α 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)) + +def VecSort_WorstCase [DecidableEq α] : Model (VecSortOps α) ℕ where + evalQuery + | .write v i x => v.set i x + | .cmp l i j => l[i] == l[j] + | .read l i => l[i] + | .swap l i j => l.swap i j + | .push a elem => a.push elem + + cost + | .write l i x => 1 + | .read l i => 1 + | .cmp l i j => 1 + | .swap l i j => 1 + | .push a elem => 2 -- amortized over array insertion and resizing by doubling + +def VecSort_CmpSwap [DecidableEq α] : Model (VecSortOps α) ℕ where + evalQuery + | .write v i x => v.set i x + | .cmp l i j => l[i] == l[j] + | .read l i => l[i] + | .swap l i j => l.swap i j + | .push a elem => a.push elem + + cost + | .cmp l i j => 1 + | .swap l i j => 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 + +#eval (simpleExample #v[1,2,3,4,5] 5 2).eval VecSort_WorstCase +#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_WorstCase +#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_CmpSwap + +end ArraySort + +section VectorLinearSearch + +inductive VecSearch (α : Type) : Type → Type where + | compare (a : Vector α n) (i : ℕ) (val : α) : VecSearch α Bool + + +def VecSearch_Nat [DecidableEq α] : Model (VecSearch α) ℕ where + evalQuery q := + match q with + | .compare l i x => l[i]? == some x + cost q := + match q with + | .compare _ _ _ => 1 + +structure CmpCount where + cmp : ℕ + pure : ℕ + +instance : Add (CmpCount) where + add x y := ⟨x.1 + y.1, x.2 + y.2⟩ + +instance : Zero (CmpCount) where + zero := ⟨0,0⟩ + +instance : PureCosts (CmpCount) where + pureCost := ⟨0,1⟩ + +def VecSearch_Cmp [DecidableEq α] : Model (VecSearch α) CmpCount where + evalQuery q := + match q with + | .compare l i x => l[i]? == some x + cost q := + match q with + | .compare _ _ _ => ⟨1,0⟩ + +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 + +#eval (linearSearch #v[12,23,31,42,52,4,6] 4).eval VecSearch_Nat +#eval (linearSearch #v[1,2,3,4,5,6] 7).eval VecSearch_Cmp + +#eval (linearSearch #v[1,2,3,22, 11, 12, 4,5,6] 4).time VecSearch_Nat +#eval (linearSearch #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Cmp + + +lemma linearSearch_correct_true [DecidableEq α] (v : Vector α n) + (hn_pos : n > 0) : + ∀ x : α, x ∈ v → (linearSearch v x).eval VecSearch_Nat = true := by + intro x x_mem_v + simp only [linearSearch] + induction n with + | zero => + simp_all + | succ n ih => + simp_all only [gt_iff_lt, lt_add_iff_pos_left, add_pos_iff, zero_lt_one, or_true] + unfold linearSearchAux + split_ifs with h_cond + · simp_all + · unfold Prog.eval + simp_all + split_ifs with h_find + · simp [Prog.eval] + · sorry + +lemma linearSearch_correct_false [DecidableEq α] (v : Vector α n) : + ∀ x : α, x ∉ v → (linearSearch v x).eval VecSearch_Nat = false := by + intro x x_mem_v + simp only [linearSearch] + induction n with + | zero => + simp_all [VecSearch_Nat] + sorry + | succ n ih => + sorry + +lemma linearSearch_time_complexity [DecidableEq α] (v : Vector α n) : + ∀ x : α, (linearSearch v x).time VecSearch_Nat ≤ n + 1 := by + intro x + simp only [linearSearch, VecSearch_Nat] + induction n with + | zero => + simp_all [linearSearchAux, time, PureCosts.pureCost] + | succ n ih => + unfold linearSearchAux + split_ifs with h_cond + · simp_all + · simp [time] + sorry + +-- The Monadic version +open VecSearch in +def linearSearchM (v : Vector α n) (x : α) : Prog (VecSearch α) Bool := do + let mut comp_res : Bool := false + for i in [0:n] do + comp_res ← compare v i x + if comp_res == true then + break + else + continue + return comp_res + +#eval (linearSearchM #v[12,23,31,42,52,4,6] 4).eval VecSearch_Nat +#eval (linearSearchM #v[1,2,3,4,5,6] 7).eval VecSearch_Nat + +#eval (linearSearchM #v[1,2,3,22, 11, 12, 4,5,6] 4).time VecSearch_Nat +#eval (linearSearchM #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Nat +#eval (linearSearchM #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Cmp + +lemma linearSearchM_correct_true [DecidableEq α] (v : Vector α n) : + ∀ x : α, x ∈ v → (linearSearchM v x).eval VecSearch_Nat = true := by + intro x x_mem_v + induction h : v.toArray.toList with + | nil => + simp_all [linearSearchM, eval] + have v_empty : h ▸ v = #v[] := by + simp + have x_not_mem_v : x ∉ v := by + subst h + aesop + tauto + | cons head tail ih => + sorry + + +lemma linearSearchM_correct_false [DecidableEq α] (v : Vector α n) : + ∀ x : α, x ∉ v → (linearSearchM v x).eval VecSearch_Nat = false := by + intro x x_mem_v + induction h : v.toArray.toList with + | nil => + simp_all [linearSearchM, eval] + | cons head tail ih => + simp_all [linearSearchM] + sorry + +lemma linearSearchM_time_complexity [DecidableEq α] (v : Vector α n) : + ∀ x : α, (linearSearchM v x).time VecSearch_Nat ≤ n + 1 := by + intro x + induction h : v.toArray.toList with + | nil => + simp_all [linearSearchM, time, PureCosts.pureCost] + | cons head tail ih => + simp_all [linearSearchM, VecSearch_Nat] + sorry + + +end VectorLinearSearch + +section ListLinearSearch +inductive ListSearch (α : Type) : Type → Type where + | compare (a : List α) (val : α) : ListSearch α Bool + + +def ListSearch_Nat [DecidableEq α] : Model (ListSearch α) ℕ where + evalQuery q := + match q with + | .compare l x => l.head? = some x + cost q := + match q with + | .compare _ _ => 1 + + +def ListSearch_Cmp [DecidableEq α] : Model (ListSearch α) CmpCount where + evalQuery q := + match q with + | .compare l x => l.head? == some x + cost q := + match q with + | .compare _ _ => ⟨1,0⟩ + +open ListSearch in +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 + +lemma listLinearSearchM_correct_true [iDec : DecidableEq α] (l : List α) : + ∀ x : α, x ∈ l → (listLinearSearch l x).eval ListSearch_Nat = true := by + intro x x_mem_l + induction l with + | nil => + simp_all only [List.not_mem_nil] + | cons head tail ih => + simp_all only [List.mem_cons, listLinearSearch, bind, FreeM.lift_def, pure, + FreeM.liftBind_bind, FreeM.pure_bind, eval] + split_ifs with h + · simp [eval] + · obtain (x_head | xtail) := x_mem_l + · rw [x_head] at h + simp[ListSearch_Nat] at h + · specialize ih xtail + exact ih + +lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) : + ∀ x : α, x ∉ l → (listLinearSearch l x).eval ListSearch_Nat = false := by + intro x x_mem_l + induction l with + | nil => + simp_all [listLinearSearch, eval] + | cons head tail ih => + simp only [List.mem_cons, not_or] at x_mem_l + specialize ih x_mem_l.2 + simp only [listLinearSearch, bind, FreeM.lift_def, pure, FreeM.liftBind_bind, FreeM.pure_bind, + eval] + split_ifs with h_eq + · simp [ListSearch_Nat] at h_eq + exfalso + exact x_mem_l.1 h_eq.symm + · exact ih + + + +lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List α) : + ∀ x : α, (listLinearSearch l x).time ListSearch_Nat ≤ 1 + l.length := by + intro x + induction l with + | nil => + simp_all [listLinearSearch, ListSearch_Nat, time, PureCosts.pureCost] + | cons head tail ih => + simp_all [listLinearSearch, ListSearch_Nat, time] + split_ifs with h_head + · simp [time, PureCosts.pureCost] + · grind + +lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Nontrivial α] : + ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = 1 + l.length := by + obtain ⟨x, y, x_neq_y⟩ := inon + use [x,x,x,x,x,y], y + simp_all [time, ListSearch_Nat, listLinearSearch, PureCosts.pureCost] + + +end ListLinearSearch + +end ProgExamples + +end Prog + +end Algorithms + +end Cslib diff --git a/Cslib/Algorithms/QueryExamples.lean b/Cslib/Algorithms/QueryExamples.lean new file mode 100644 index 000000000..b40bcdbe5 --- /dev/null +++ b/Cslib/Algorithms/QueryExamples.lean @@ -0,0 +1,72 @@ +/- +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.Algorithms.QueryModel + + +@[expose] public section + +namespace Cslib + +namespace Algorithms + +section Examples + +inductive ListOps (α : Type) : Type → Type where + | get (l : List α) (i : Fin l.length) : ListOps α α + | find (l : List α) (elem : α) : ListOps α ℕ + | write (l : List α) (i : Fin l.length) (x : α) : ListOps α (List α) + + +def List_LinSearch_WorstCase [DecidableEq α] : Model (ListOps α) ℕ where + evalQuery + | .write l i x => l.set i x + | .find l elem => l.findIdx (· = elem) + | .get l i => l[i] + cost + | .write l i x => l.length + | .find l elem => l.length + | .get l i => l.length + + + +def List_BinSearch_WorstCase [BEq α] : Model (ListOps α) ℕ where + evalQuery + | .write l i x => l.set i x + | .get l i => l[i] + | .find l elem => l.findIdx (· == elem) + + cost + | .find l _ => 1 + Nat.log 2 (l.length) + | .write l i x => l.length + | .get l x => l.length + +inductive ArrayOps (α : Type) : Type → Type where + | get : (l : Array α) → (i : Fin l.size) → ArrayOps α α + | find : (l : Array α) → α → ArrayOps α ℕ + | write : (l : Array α) → (i : Fin l.size) → (x : α) → ArrayOps α (Array α) + + +def Array_BinSearch_WorstCase [BEq α] : Model (ArrayOps α) ℕ where + evalQuery + | .write l i x => l.set i x + | .get l i => l[i] + | .find l elem => l.findIdx (· == elem) + + cost + | .find l _ => 1 + Nat.log 2 (l.size) + | .write l i x => 1 + | .get l x => 1 + + + +end Examples + +end Algorithms + +end Cslib diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 24edb38e5..dbbbbc5df 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -17,16 +17,29 @@ public import Batteries # Query model This file defines a simple query language modeled as a free monad over a -parametric type of query operations. +parametric type of query operations. ## Main definitions -- `QueryF`, `Prog` : query language and programs -- `evalQuery`, `evalProg` : concrete execution semantics +- `PureCosts` : A typeclass that every model needs to log or cost pure monadic operations +- `Model Q` : A model type for a query type `Q : Type u → Type u` +- `Prog Q α` : The type of programs of query type `Q` and return type `α`. This is a free monad + under the hood +- `eval`, `time` : concrete execution semantics of a `Prog Q α` for a given model of `Q` + +## Important notes + +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 which carries. This type must have one parameter `α` and + one index type. The parameter type `α` is the return type of an + which is the type supplied to the query and an index which denotes the output type of each query + +2. C ## Tags -query model, free monad, time complexity, merge sort +query model, free monad, time complexity, Prog -/ namespace Cslib @@ -36,7 +49,7 @@ namespace Algorithms class PureCosts (α : Type u) where pureCost : α -instance : PureCosts ℕ where +scoped instance : PureCosts ℕ where pureCost := 1 structure Model (QType : Type u → Type u) (Cost : Type) [Add Cost] [Zero Cost] @@ -44,63 +57,6 @@ structure Model (QType : Type u → Type u) (Cost : Type) [Add Cost] [Zero Cost] evalQuery : QType ι → ι cost : QType ι → Cost -namespace Model - - - -section Examples - -inductive ListOps (α : Type) : Type → Type where - | get (l : List α) (i : Fin l.length) : ListOps α α - | find (l : List α) (elem : α) : ListOps α ℕ - | write (l : List α) (i : Fin l.length) (x : α) : ListOps α (List α) - - -def List_LinSearch_WorstCase [DecidableEq α] : Model (ListOps α) ℕ where - evalQuery - | .write l i x => l.set i x - | .find l elem => l.findIdx (· = elem) - | .get l i => l[i] - cost - | .write l i x => l.length - | .find l elem => l.length - | .get l i => l.length - - - -def List_BinSearch_WorstCase [BEq α] : Model (ListOps α) ℕ where - evalQuery - | .write l i x => l.set i x - | .get l i => l[i] - | .find l elem => l.findIdx (· == elem) - - cost - | .find l _ => 1 + Nat.log 2 (l.length) - | .write l i x => l.length - | .get l x => l.length - -inductive ArrayOps (α : Type) : Type → Type where - | get : (l : Array α) → (i : Fin l.size) → ArrayOps α α - | find : (l : Array α) → α → ArrayOps α ℕ - | write : (l : Array α) → (i : Fin l.size) → (x : α) → ArrayOps α (Array α) - -def Array_BinSearch_WorstCase [BEq α] : Model (ArrayOps α) ℕ where - evalQuery - | .write l i x => l.set i x - | .get l i => l[i] - | .find l elem => l.findIdx (· == elem) - - cost - | .find l _ => 1 + Nat.log 2 (l.size) - | .write l i x => 1 - | .get l x => 1 - - - -end Examples - -end Model - abbrev Prog Q α := FreeM Q α instance {Q α} : Coe (Q α) (FreeM Q α) where @@ -156,372 +112,19 @@ def liftProgIntoTime (M : Model Q ℕ) (P : Prog Q α) : TimeM α := end TimeM -section ProgExamples - -inductive Arith (α : Type) : Type → Type where - | add (x y : α) : Arith α α - | mul (x y : α) : Arith α α - | neg (x : α) : Arith α α - | zero : Arith α α - | one : Arith α α - -def RatArithQuery_NatCost : Model (Arith ℚ) ℕ where - evalQuery q := - match q with - | .add x y => x + y - | .mul x y => x * y - | .neg x => -x - | .zero => (0 : ℚ) - | .one => (1 : ℚ) - cost _ := 1 - -structure AddMulCosts where - addCount : ℕ - mulCount : ℕ - pure : ℕ - -instance : Zero (AddMulCosts) where - zero := ⟨0,0,0⟩ - -instance : PureCosts (AddMulCosts) where - pureCost := ⟨0,0,1⟩ - -instance : Add (AddMulCosts) where - add x y := - let ⟨x_addcount, x_mulcount, x_pure⟩ := x - let ⟨y_addcount, y_mulcount, y_pure⟩ := y - ⟨x_addcount + y_addcount, x_mulcount + y_mulcount, x_pure + y_pure⟩ - -def RatArithQuery_AddMulCost : Model (Arith ℚ) AddMulCosts where - evalQuery - | .add x y => x + y - | .mul x y => x * y - | .neg x => -x - | .zero => (0 : ℚ) - | .one => (1 : ℚ) - cost - | .add _ _ => ⟨1,0,0⟩ - | .mul _ _ => ⟨0,1,0⟩ - | _ => 0 - -open Arith in -def ex1 : Prog (Arith ℚ) ℚ := do - let mut x : ℚ ← @zero ℚ - let mut y ← @one ℚ - let z ← (add (x + y + y) y) - let w ← @neg ℚ (←(add z y)) - add w z - - -#eval ex1.eval RatArithQuery_NatCost -#eval ex1.time RatArithQuery_NatCost -#eval ex1.time RatArithQuery_AddMulCost - -section ArraySort -/-- -The array version of the sort operations --/ -inductive VecSortOps (α : Type) : Type → Type where - | swap : (a : Vector α n) → (i j : Fin n) → VecSortOps α (Vector α n) - | cmp : (a : Vector α n) → (i j : Fin n) → VecSortOps α 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)) - -def VecSort_WorstCase [DecidableEq α] : Model (VecSortOps α) ℕ where - evalQuery - | .write v i x => v.set i x - | .cmp l i j => l[i] == l[j] - | .read l i => l[i] - | .swap l i j => l.swap i j - | .push a elem => a.push elem - - cost - | .write l i x => 1 - | .read l i => 1 - | .cmp l i j => 1 - | .swap l i j => 1 - | .push a elem => 2 -- amortized over array insertion and resizing by doubling - -def VecSort_CmpSwap [DecidableEq α] : Model (VecSortOps α) ℕ where - evalQuery - | .write v i x => v.set i x - | .cmp l i j => l[i] == l[j] - | .read l i => l[i] - | .swap l i j => l.swap i j - | .push a elem => a.push elem - - cost - | .cmp l i j => 1 - | .swap l i j => 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 - -#eval (simpleExample #v[1,2,3,4,5] 5 2).eval VecSort_WorstCase -#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_WorstCase -#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_CmpSwap - -end ArraySort - -section VectorLinearSearch - -inductive VecSearch (α : Type) : Type → Type where - | compare (a : Vector α n) (i : ℕ) (val : α) : VecSearch α Bool - - -def VecSearch_Nat [DecidableEq α] : Model (VecSearch α) ℕ where - evalQuery q := - match q with - | .compare l i x => l[i]? == some x - cost q := - match q with - | .compare _ _ _ => 1 - -structure CmpCount where - cmp : ℕ - pure : ℕ - -instance : Add (CmpCount) where - add x y := ⟨x.1 + y.1, x.2 + y.2⟩ - -instance : Zero (CmpCount) where - zero := ⟨0,0⟩ - -instance : PureCosts (CmpCount) where - pureCost := ⟨0,1⟩ - -def VecSearch_Cmp [DecidableEq α] : Model (VecSearch α) CmpCount where - evalQuery q := - match q with - | .compare l i x => l[i]? == some x - cost q := - match q with - | .compare _ _ _ => ⟨1,0⟩ - -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 - -#eval (linearSearch #v[12,23,31,42,52,4,6] 4).eval VecSearch_Nat -#eval (linearSearch #v[1,2,3,4,5,6] 7).eval VecSearch_Cmp - -#eval (linearSearch #v[1,2,3,22, 11, 12, 4,5,6] 4).time VecSearch_Nat -#eval (linearSearch #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Cmp - - -lemma linearSearch_correct_true [DecidableEq α] (v : Vector α n) - (hn_pos : n > 0) : - ∀ x : α, x ∈ v → (linearSearch v x).eval VecSearch_Nat = true := by - intro x x_mem_v - simp only [linearSearch] - induction n with - | zero => - simp_all - | succ n ih => - simp_all only [gt_iff_lt, lt_add_iff_pos_left, add_pos_iff, zero_lt_one, or_true] - unfold linearSearchAux - split_ifs with h_cond - · simp_all - · unfold eval - simp_all - split_ifs with h_find - · simp [eval] - · sorry - -lemma linearSearch_correct_false [DecidableEq α] (v : Vector α n) : - ∀ x : α, x ∉ v → (linearSearch v x).eval VecSearch_Nat = false := by - intro x x_mem_v - simp only [linearSearch] - induction n with - | zero => - simp_all [VecSearch_Nat] - sorry - | succ n ih => - sorry - -lemma linearSearch_time_complexity [DecidableEq α] (v : Vector α n) : - ∀ x : α, (linearSearch v x).time VecSearch_Nat ≤ n + 1 := by - intro x - simp only [linearSearch, VecSearch_Nat] - induction n with - | zero => - simp_all [linearSearchAux, time, PureCosts.pureCost] - | succ n ih => - unfold linearSearchAux - split_ifs with h_cond - · simp_all - · simp [time] - sorry - --- The Monadic version -open VecSearch in -def linearSearchM (v : Vector α n) (x : α) : Prog (VecSearch α) Bool := do - let mut comp_res : Bool := false - for i in [0:n] do - comp_res ← compare v i x - if comp_res == true then - break - else - continue - return comp_res - -#eval (linearSearchM #v[12,23,31,42,52,4,6] 4).eval VecSearch_Nat -#eval (linearSearchM #v[1,2,3,4,5,6] 7).eval VecSearch_Nat - -#eval (linearSearchM #v[1,2,3,22, 11, 12, 4,5,6] 4).time VecSearch_Nat -#eval (linearSearchM #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Nat -#eval (linearSearchM #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Cmp - -lemma linearSearchM_correct_true [DecidableEq α] (v : Vector α n) : - ∀ x : α, x ∈ v → (linearSearchM v x).eval VecSearch_Nat = true := by - intro x x_mem_v - induction h : v.toArray.toList with - | nil => - simp_all [linearSearchM, eval] - have v_empty : h ▸ v = #v[] := by - simp - have x_not_mem_v : x ∉ v := by - subst h - aesop - tauto - | cons head tail ih => - sorry - - -lemma linearSearchM_correct_false [DecidableEq α] (v : Vector α n) : - ∀ x : α, x ∉ v → (linearSearchM v x).eval VecSearch_Nat = false := by - intro x x_mem_v - induction h : v.toArray.toList with - | nil => - simp_all [linearSearchM, eval] - | cons head tail ih => - simp_all [linearSearchM] - sorry - -lemma linearSearchM_time_complexity [DecidableEq α] (v : Vector α n) : - ∀ x : α, (linearSearchM v x).time VecSearch_Nat ≤ n + 1 := by - intro x - induction h : v.toArray.toList with - | nil => - simp_all [linearSearchM, time, PureCosts.pureCost] - | cons head tail ih => - simp_all [linearSearchM, VecSearch_Nat] - sorry - - -end VectorLinearSearch - -section ListLinearSearch -inductive ListSearch (α : Type) : Type → Type where - | compare (a : List α) (val : α) : ListSearch α Bool - - -def ListSearch_Nat [DecidableEq α] : Model (ListSearch α) ℕ where - evalQuery q := - match q with - | .compare l x => l.head? = some x - cost q := - match q with - | .compare _ _ => 1 - - -def ListSearch_Cmp [DecidableEq α] : Model (ListSearch α) CmpCount where - evalQuery q := - match q with - | .compare l x => l.head? == some x - cost q := - match q with - | .compare _ _ => ⟨1,0⟩ - -open ListSearch in -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 - -lemma listLinearSearchM_correct_true [iDec : DecidableEq α] (l : List α) : - ∀ x : α, x ∈ l → (listLinearSearch l x).eval ListSearch_Nat = true := by - intro x x_mem_l - induction l with - | nil => - simp_all only [List.not_mem_nil] - | cons head tail ih => - simp_all only [List.mem_cons, listLinearSearch, bind, FreeM.lift_def, pure, - FreeM.liftBind_bind, FreeM.pure_bind, eval] - split_ifs with h - · simp [eval] - · obtain (x_head | xtail) := x_mem_l - · rw [x_head] at h - simp[ListSearch_Nat] at h - · specialize ih xtail - exact ih - -lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) : - ∀ x : α, x ∉ l → (listLinearSearch l x).eval ListSearch_Nat = false := by - intro x x_mem_l - induction l with - | nil => - simp_all [listLinearSearch, eval] - | cons head tail ih => - simp only [List.mem_cons, not_or] at x_mem_l - specialize ih x_mem_l.2 - simp only [listLinearSearch, bind, FreeM.lift_def, pure, FreeM.liftBind_bind, FreeM.pure_bind, - eval] - split_ifs with h_eq - · simp [ListSearch_Nat] at h_eq - exfalso - exact x_mem_l.1 h_eq.symm - · exact ih - - - -lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List α) : - ∀ x : α, (listLinearSearch l x).time ListSearch_Nat ≤ 1 + l.length := by - intro x - induction l with - | nil => - simp_all [listLinearSearch, ListSearch_Nat, time, PureCosts.pureCost] - | cons head tail ih => - simp_all [listLinearSearch, ListSearch_Nat, time] - split_ifs with h_head - · simp [time, PureCosts.pureCost] - · grind - -lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Nontrivial α] : - ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = 1 + l.length := by - obtain ⟨x, y, x_neq_y⟩ := inon - use [x,x,x,x,x,y], y - simp_all [time, ListSearch_Nat, listLinearSearch, PureCosts.pureCost] - - -end ListLinearSearch - -end ProgExamples + + +section Reduction + +structure Reduction (Q Q' : Type u → Type u) where + reduce : Q' α → Prog Q α + + + + +end Reduction + + end Prog From c2529f796a3344a1b05cbd2952d1f3d047e4bc78 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sun, 25 Jan 2026 04:16:00 +0100 Subject: [PATCH 047/176] Add copyright header --- Cslib/Algorithms/ProgExamples.lean | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Cslib/Algorithms/ProgExamples.lean b/Cslib/Algorithms/ProgExamples.lean index 0060203b0..93932cadb 100644 --- a/Cslib/Algorithms/ProgExamples.lean +++ b/Cslib/Algorithms/ProgExamples.lean @@ -1,3 +1,9 @@ +/- +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.Algorithms.QueryModel From db100ea2101d8dc5088cadad5ea359bfc8f31fa3 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sun, 25 Jan 2026 05:45:05 +0100 Subject: [PATCH 048/176] Improve docs --- Cslib/Algorithms/QueryModel.lean | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index dbbbbc5df..36aa95ef8 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -22,21 +22,25 @@ parametric type of query operations. ## Main definitions - `PureCosts` : A typeclass that every model needs to log or cost pure monadic operations -- `Model Q` : A model type for a query type `Q : Type u → Type u` +- `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 - `eval`, `time` : concrete execution semantics of a `Prog Q α` for a given model of `Q` -## Important notes +## 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 which carries. This type must have one parameter `α` and - one index type. The parameter type `α` is the return type of an - which is the type supplied to the query and an index which denotes the output type of each query - -2. C +1. Define an inductive type of queries which carries. This type must at least one index parameter + which denotes 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 one or more cost types `C` and instances of `PureCosts` for this cost type. +3. Define a `Model Q C` type instance +4. 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 @@ -124,8 +128,6 @@ structure Reduction (Q Q' : Type u → Type u) where end Reduction - - end Prog end Algorithms From 64621458a004a2965700270494b20e874bd7a21c Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 26 Jan 2026 02:33:39 +0100 Subject: [PATCH 049/176] Circuit complexitygit add *! --- Cslib/Algorithms/CircuitProgs.lean | 127 +++++++++++++++++++++++++++++ Cslib/Algorithms/ProgExamples.lean | 1 + 2 files changed, 128 insertions(+) create mode 100644 Cslib/Algorithms/CircuitProgs.lean diff --git a/Cslib/Algorithms/CircuitProgs.lean b/Cslib/Algorithms/CircuitProgs.lean new file mode 100644 index 000000000..1ef31d6d4 --- /dev/null +++ b/Cslib/Algorithms/CircuitProgs.lean @@ -0,0 +1,127 @@ +module + +public import Cslib.Algorithms.QueryModel + +@[expose] public section + +namespace Cslib + +namespace Algorithms + +namespace Prog +inductive Circuit (α : Type u) : Type u → Type u where + | const (id : ℕ) (x : α) : Circuit α α + | add (id : ℕ) (c₁ c₂ : Circuit α α) : Circuit α α + | mul (id : ℕ) (c₁ c₂ : Circuit α α) : Circuit α α + | neg (id : ℕ) (c : Circuit α α) : Circuit α α + +structure CircuitCosts where + depth : ℕ + size : ℕ + nodeIDList : List ℕ + +instance : PureCosts CircuitCosts where + pureCost := ⟨0,0, []⟩ + +instance : Zero CircuitCosts where + zero := ⟨0,0, []⟩ + +instance : Add CircuitCosts where + add x y := ⟨x.1 + y.1, x.2 + y.2, x.3 ++ y.3⟩ + +def circEval (α : Type u) [Add α] [Mul α] [Neg α] (c : Circuit α ι) : ι := + match c with + | .const _ x => x + | .add _ c₁ c₂ => circEval α c₁ + circEval α c₂ + | .mul _ c₁ c₂ => circEval α c₁ * circEval α c₂ + | .neg _ c => - circEval α c + +def depthOf (q : Circuit α β) := + match q with + | .const _ c => 0 + | .add _ c₁ c₂ => 1 + max (depthOf c₁) (depthOf c₂) + | .mul _ c₁ c₂ => 1 + max (depthOf c₁) (depthOf c₂) + | .neg _ c => 1 + depthOf c + +def uniqueIDs (q : Circuit α β) (countedIDs : List ℕ) : List ℕ := + match q with + | .const id _ => + if id ∉ countedIDs then id :: countedIDs else countedIDs + | .add id x y => + let s₁ := uniqueIDs x countedIDs + let s₂ := uniqueIDs y s₁ + if id ∉ s₂ + then + id :: s₂ + else + s₂ + | .mul id x y => + let s₁ := uniqueIDs x countedIDs + let s₂ := uniqueIDs y s₁ + if id ∉ s₂ + then id :: s₂ + else s₂ + | .neg id x => + let s := uniqueIDs x countedIDs + if id ∉ s + then id :: s + else s + + +def sizeOf (q : Circuit α β) := (uniqueIDs q []).length + +def circModel (α : Type u) [Add α] [Mul α] [Neg α] : Model (Circuit α) CircuitCosts where + evalQuery q := circEval α q + cost q := ⟨depthOf q, sizeOf q, uniqueIDs q []⟩ + +open Circuit in +def exCircuit1 : Prog (Circuit Bool) Bool := do + let x := const 0 true + let y := const 1 true + let z := add 2 x y + let w := mul 3 x y + add 4 z w + +#eval exCircuit1.eval (circModel Bool) +#eval exCircuit1.time (circModel Bool) + +open Circuit in +def exCircuit2 : Prog (Circuit ℚ) ℚ := do + let x := const 0 (1 : ℚ) + let y := const 1 (2 : ℚ) + let z := add 2 x y + mul 4 z z + +#eval exCircuit2.eval (circModel ℚ) +#eval exCircuit2.time (circModel ℚ) + +open Circuit in +def exCircuit3 (x y : Circuit ℚ ℚ) : Prog (Circuit ℚ) ℚ := do + let z := add 2 x y + let w := mul 3 x y + mul 4 z w + +#eval (exCircuit3 (.const 0 (1 : ℚ)) (.const 1 (21 : ℚ))).eval (circModel ℚ) +#eval (exCircuit3 (.const 0 (1 : ℚ)) (.const 1 (21 : ℚ))).time (circModel ℚ) + + +open Circuit in +def CircAnd (n : ℕ) (x : Fin n → Circuit Bool Bool) : Circuit Bool Bool := + match n with + | 0 => const n true + | m + 1 => + let x_head := x 0 + let x_cons := CircAnd m (Fin.tail x) + mul (n + m + 1) x_head x_cons + +def execCircAnd (x : Fin n → Circuit Bool Bool) : Prog (Circuit Bool) Bool := do + CircAnd n x + +#eval (execCircAnd ![.const 0 true, .const 1 true, .const 2 true]).eval (circModel Bool) +#eval (execCircAnd ![.const 0 true, .const 1 true, .const 2 true]).time (circModel Bool) + +end Prog + +end Algorithms + +end Cslib diff --git a/Cslib/Algorithms/ProgExamples.lean b/Cslib/Algorithms/ProgExamples.lean index 93932cadb..0e6ee003b 100644 --- a/Cslib/Algorithms/ProgExamples.lean +++ b/Cslib/Algorithms/ProgExamples.lean @@ -77,6 +77,7 @@ def ex1 : Prog (Arith ℚ) ℚ := do #eval ex1.time RatArithQuery_NatCost #eval ex1.time RatArithQuery_AddMulCost + section ArraySort /-- The array version of the sort operations From 5acdf883d5824dcf67e795d27c4acba66ab43c20 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 26 Jan 2026 02:42:56 +0100 Subject: [PATCH 050/176] add copyright comment to CircuitProgs.lean --- Cslib/Algorithms/CircuitProgs.lean | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Cslib/Algorithms/CircuitProgs.lean b/Cslib/Algorithms/CircuitProgs.lean index 1ef31d6d4..2cd96153b 100644 --- a/Cslib/Algorithms/CircuitProgs.lean +++ b/Cslib/Algorithms/CircuitProgs.lean @@ -1,3 +1,9 @@ +/- +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.Algorithms.QueryModel From 2888f3db72a7027762947cf5691ba2552d085752 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 28 Jan 2026 16:23:01 +0100 Subject: [PATCH 051/176] Circuits with automatic IDs --- Cslib/Algorithms/CircuitLineProgs.lean | 135 +++++++++++++++++++++++++ Cslib/Algorithms/CircuitProgs.lean | 90 ++++++++++++++--- Cslib/Algorithms/ProgExamples.lean | 10 +- Cslib/Algorithms/QueryModel.lean | 7 +- 4 files changed, 219 insertions(+), 23 deletions(-) create mode 100644 Cslib/Algorithms/CircuitLineProgs.lean diff --git a/Cslib/Algorithms/CircuitLineProgs.lean b/Cslib/Algorithms/CircuitLineProgs.lean new file mode 100644 index 000000000..398bb76cd --- /dev/null +++ b/Cslib/Algorithms/CircuitLineProgs.lean @@ -0,0 +1,135 @@ +/- +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.Algorithms.QueryModel + +@[expose] public section + +namespace Cslib + +namespace Algorithms + +namespace Prog +inductive Circuit (n : ℕ) (α : Type u) : Type u → Type u where + | const (x : α) : Circuit n α α + | add (c₁ c₂ : Fin n) : Circuit n α α + | mul (c₁ c₂ : Fin n) : Circuit n α α + | neg (c : Fin n) : Circuit n α α + +structure CircuitLines (n : ℕ) (α ι : Type u) : Type u where + circuits : (i : Fin n) → Circuit i ι ι + +structure CircuitCosts where + depth : ℕ + size : ℕ + nodeIDList : List ℕ + +instance : PureCosts CircuitCosts where + pureCost := ⟨0,0, []⟩ + +instance : Zero CircuitCosts where + zero := ⟨0,0, []⟩ + +instance : Add CircuitCosts where + add x y := ⟨x.1 + y.1, x.2 + y.2, x.3 ++ y.3⟩ + +variable (α : Type u) [Add α] [Mul α] [Neg α] + +def circEval {n : ℕ} (c : CircuitLines n α α) (id : Fin n) : α := + match (c.circuits id) with + | .const x => x + | .add id₁ id₂ => circEval c ⟨id₁, by grind⟩ + circEval c ⟨id₂, by grind⟩ + | .mul id₁ id₂ => circEval c ⟨id₁, by grind⟩ * circEval c ⟨id₂, by grind⟩ + | .neg id => - circEval c ⟨id, by grind⟩ +termination_by id + + +def depthOf (c : CircuitLines n α α) (id : Fin n) := + match (c.circuits id) with + | .const c => 0 + | .add id₁ id₂ => 1 + max (depthOf c ⟨id₁, by grind⟩) (depthOf c ⟨id₂, by grind⟩) + | .mul id₁ id₂ => 1 + max (depthOf c ⟨id₁, by grind⟩) (depthOf c ⟨id₂, by grind⟩) + | .neg id => 1 + depthOf c ⟨id, by grind⟩ + +def uniqueIDs (q : CircuitLines n α α) (countedIDs : List ℕ) (id : Fin n) : List ℕ := + match (q.circuits id) with + | .const _ => + countedIDs.insert id + | .add id₁ id₂ => + let s₁ := uniqueIDs q countedIDs ⟨id₁, by grind⟩ + let s₂ := uniqueIDs q s₁ ⟨id₂, by clear s₁; grind⟩ + s₂.insert id + | .mul id₁ id₂ => + let s₁ := uniqueIDs q countedIDs ⟨id₁, by grind⟩ + let s₂ := uniqueIDs q s₁ ⟨id₂, by clear s₁; grind⟩ + s₂.insert id + | .neg c => + let s := uniqueIDs q countedIDs ⟨c, by grind⟩ + s.insert id + +def sizeOf (q : CircuitLines n α α) (id : Fin n) := (uniqueIDs α q [] id).length + +def circModel [Add ι] [Mul ι] [Neg ι] : Model (CircuitLines (n + 1) ι) CircuitCosts where + evalQuery {ι} q := @circEval ι q ⟨n, by grind⟩ + cost q := ⟨depthOf q, sizeOf q, uniqueIDs q []⟩ + + +open Circuit in +def exCircuit1 : Prog (Circuit Bool) Bool := do + let x := const 0 true + let y := const 1 true + let z := add 2 x y + let w := mul 3 x y + add 4 z w + +#eval exCircuit1.eval (circModel Bool) +#eval exCircuit1.time (circModel Bool) + +open Circuit in +def exCircuit2 : Prog (Circuit ℚ) ℚ := do + let x := const 0 (1 : ℚ) + let y := const 1 (2 : ℚ) + let z := add 2 x y + mul 4 z z + +#eval exCircuit2.eval (circModel ℚ) +#eval exCircuit2.time (circModel ℚ) + +open Circuit in +def exCircuit3 (x y : Circuit ℚ ℚ) : Prog (Circuit ℚ) ℚ := do + let z := add 2 x y + let w := mul 3 x y + mul 4 z w + +#eval (exCircuit3 (.const 0 (1 : ℚ)) (.const 1 (21 : ℚ))).eval (circModel ℚ) +#eval (exCircuit3 (.const 0 (1 : ℚ)) (.const 1 (21 : ℚ))).time (circModel ℚ) + + +open Circuit in +def CircAnd (n : ℕ) (x : Fin n → Circuit Bool Bool) : Circuit Bool Bool := + match n with + | 0 => const n true + | m + 1 => + let x_head := x 0 + let x_cons := CircAnd m (Fin.tail x) + mul (n + m + 1) x_head x_cons + +def execCircAnd (x : Fin n → Circuit Bool Bool) : Prog (Circuit Bool) Bool := do + CircAnd n x + +#eval (execCircAnd ![.const 0 true, .const 1 true, .const 2 true]).eval (circModel Bool) +#eval (execCircAnd ![.const 0 true, .const 1 true, .const 2 true]).time (circModel Bool) + + + + +end Prog + +end Algorithms + +end Cslib diff --git a/Cslib/Algorithms/CircuitProgs.lean b/Cslib/Algorithms/CircuitProgs.lean index 2cd96153b..05e618e8e 100644 --- a/Cslib/Algorithms/CircuitProgs.lean +++ b/Cslib/Algorithms/CircuitProgs.lean @@ -20,6 +20,7 @@ inductive Circuit (α : Type u) : Type u → Type u where | add (id : ℕ) (c₁ c₂ : Circuit α α) : Circuit α α | mul (id : ℕ) (c₁ c₂ : Circuit α α) : Circuit α α | neg (id : ℕ) (c : Circuit α α) : Circuit α α +deriving Repr structure CircuitCosts where depth : ℕ @@ -42,6 +43,7 @@ def circEval (α : Type u) [Add α] [Mul α] [Neg α] (c : Circuit α ι) : ι : | .mul _ c₁ c₂ => circEval α c₁ * circEval α c₂ | .neg _ c => - circEval α c + def depthOf (q : Circuit α β) := match q with | .const _ c => 0 @@ -56,23 +58,14 @@ def uniqueIDs (q : Circuit α β) (countedIDs : List ℕ) : List ℕ := | .add id x y => let s₁ := uniqueIDs x countedIDs let s₂ := uniqueIDs y s₁ - if id ∉ s₂ - then - id :: s₂ - else - s₂ + s₂.insert id | .mul id x y => let s₁ := uniqueIDs x countedIDs let s₂ := uniqueIDs y s₁ - if id ∉ s₂ - then id :: s₂ - else s₂ + s₂.insert id | .neg id x => let s := uniqueIDs x countedIDs - if id ∉ s - then id :: s - else s - + s.insert id def sizeOf (q : Circuit α β) := (uniqueIDs q []).length @@ -80,6 +73,7 @@ def circModel (α : Type u) [Add α] [Mul α] [Neg α] : Model (Circuit α) Circ evalQuery q := circEval α q cost q := ⟨depthOf q, sizeOf q, uniqueIDs q []⟩ + open Circuit in def exCircuit1 : Prog (Circuit Bool) Bool := do let x := const 0 true @@ -98,17 +92,28 @@ def exCircuit2 : Prog (Circuit ℚ) ℚ := do let z := add 2 x y mul 4 z z + +#eval exCircuit2.eval (circModel ℚ) +#eval exCircuit2.time (circModel ℚ) + +open Circuit in +def exCircuit3 : Prog (Circuit ℚ) ℚ := do + let x := const 0 (1 : ℚ) + let y := const 1 (2 : ℚ) + let z := add 2 x y + mul 4 z z + #eval exCircuit2.eval (circModel ℚ) #eval exCircuit2.time (circModel ℚ) open Circuit in -def exCircuit3 (x y : Circuit ℚ ℚ) : Prog (Circuit ℚ) ℚ := do +def exCircuit4 (x y : Circuit ℚ ℚ) : Prog (Circuit ℚ) ℚ := do let z := add 2 x y let w := mul 3 x y mul 4 z w -#eval (exCircuit3 (.const 0 (1 : ℚ)) (.const 1 (21 : ℚ))).eval (circModel ℚ) -#eval (exCircuit3 (.const 0 (1 : ℚ)) (.const 1 (21 : ℚ))).time (circModel ℚ) +#eval (exCircuit4 (.const 0 (1 : ℚ)) (.const 1 (21 : ℚ))).eval (circModel ℚ) +#eval (exCircuit4 (.const 0 (1 : ℚ)) (.const 1 (21 : ℚ))).time (circModel ℚ) open Circuit in @@ -126,6 +131,61 @@ def execCircAnd (x : Fin n → Circuit Bool Bool) : Prog (Circuit Bool) Bool := #eval (execCircAnd ![.const 0 true, .const 1 true, .const 2 true]).eval (circModel Bool) #eval (execCircAnd ![.const 0 true, .const 1 true, .const 2 true]).time (circModel Bool) + +section CircuitQuery + +-- Another query type that reduces to Circuit queries. automates identification of nodes + +inductive CircuitQuery (α : Type u) : Type u → Type u where + | const (x : α) : CircuitQuery α (Circuit α α) + | add (c₁ c₂ : CircuitQuery α (Circuit α α)) : CircuitQuery α (Circuit α α) + | mul (c₁ c₂ : CircuitQuery α (Circuit α α)) : CircuitQuery α (Circuit α α) + | neg (c : CircuitQuery α (Circuit α α)) : CircuitQuery α (Circuit α α) + +def circQueryEvalAux (α : Type u) (id : ℕ) + (c : CircuitQuery α ι) : ι := + match c with + | .const x => Circuit.const id x + | .add c₁ c₂ => Circuit.add id (circQueryEvalAux α (id + 1) c₁) (circQueryEvalAux α (id + 2) c₂) + | .mul c₁ c₂ => Circuit.add id (circQueryEvalAux α (id + 1) c₁) (circQueryEvalAux α (id + 2) c₂) + | .neg c => Circuit.neg id (circQueryEvalAux α (id + 1) c) + +def sizeCircQuery (c : CircuitQuery α (Circuit α β)) : CircuitCosts := + let c' := circQueryEvalAux α 0 c + ⟨depthOf c', sizeOf c', uniqueIDs c' []⟩ + +def circQueryModel (α : Type u) [Add α] [Mul α] [Neg α] : Model (CircuitQuery α) CircuitCosts where + evalQuery q := circQueryEvalAux α 0 q + cost q := match q with + | .const x => sizeCircQuery (.const x) + | .add c₁ c₂ => sizeCircQuery (.add c₁ c₂) + | .mul c₁ c₂ => sizeCircQuery (.mul c₁ c₂) + | .neg c => sizeCircQuery (.neg c) + + +def reduceToCirc {α} [iadd : Add α] [imul : Mul α] [ineg : Neg α] + (P : Prog (CircuitQuery α) (Circuit α α)) : Prog (Circuit α) α := do + P.eval (circQueryModel α) + +open CircuitQuery in +def ex5 : Prog (CircuitQuery ℚ) (Circuit ℚ ℚ) := do + let x := const (1 : ℚ) + let y := const (2 : ℚ) + let z := add x y + mul z z + + +#eval ex5.eval (circQueryModel ℚ) +#eval ex5.time (circQueryModel ℚ) + +open CircuitQuery in +def ex6 (a b : CircuitQuery ℚ (Circuit ℚ ℚ)) : Prog (CircuitQuery ℚ) (Circuit ℚ ℚ) := do + let x := a + let y := b + let z := add x y + mul z z + +end CircuitQuery end Prog end Algorithms diff --git a/Cslib/Algorithms/ProgExamples.lean b/Cslib/Algorithms/ProgExamples.lean index 0e6ee003b..41e497c82 100644 --- a/Cslib/Algorithms/ProgExamples.lean +++ b/Cslib/Algorithms/ProgExamples.lean @@ -203,11 +203,11 @@ lemma linearSearch_correct_true [DecidableEq α] (v : Vector α n) unfold linearSearchAux split_ifs with h_cond · simp_all - · unfold Prog.eval - simp_all - split_ifs with h_find - · simp [Prog.eval] - · sorry + · simp [eval,liftBind] + unfold Prog.eval + simp_all only [ge_iff_le, nonpos_iff_eq_zero, Nat.add_eq_zero_iff, one_ne_zero, and_false, + not_false_eq_true, bind, FreeM.lift_def, pure, zero_add, FreeM.liftBind_bind, + FreeM.pure_bind] lemma linearSearch_correct_false [DecidableEq α] (v : Vector α n) : ∀ x : α, x ∉ v → (linearSearch v x).eval VecSearch_Nat = false := by diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index 36aa95ef8..c53dcdf07 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -120,10 +120,11 @@ end TimeM section Reduction -structure Reduction (Q Q' : Type u → Type u) where - reduce : Q' α → Prog Q α - +structure Reduction (Q₁ Q₂ : Type u → Type u) where + reduce : Q₁ α → Prog Q₂ α +def reduceProg (P : Prog Q₁ α) (red : Reduction Q₁ Q₂) : Prog Q₂ α := + P.liftM red.reduce end Reduction From 7532c850ab7cb3d3a339bfbfef04d8cc14c86f8b Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 28 Jan 2026 16:39:51 +0100 Subject: [PATCH 052/176] Eric's suggestion --- Cslib/Algorithms/CircuitProgs.lean | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/Cslib/Algorithms/CircuitProgs.lean b/Cslib/Algorithms/CircuitProgs.lean index 05e618e8e..2a9ee6aff 100644 --- a/Cslib/Algorithms/CircuitProgs.lean +++ b/Cslib/Algorithms/CircuitProgs.lean @@ -54,7 +54,7 @@ def depthOf (q : Circuit α β) := def uniqueIDs (q : Circuit α β) (countedIDs : List ℕ) : List ℕ := match q with | .const id _ => - if id ∉ countedIDs then id :: countedIDs else countedIDs + countedIDs.insert id | .add id x y => let s₁ := uniqueIDs x countedIDs let s₂ := uniqueIDs y s₁ @@ -185,7 +185,11 @@ def ex6 (a b : CircuitQuery ℚ (Circuit ℚ ℚ)) : Prog (CircuitQuery ℚ) (Ci let z := add x y mul z z +#eval (ex6 (.const 0) (.const 1)).eval (circQueryModel ℚ) +#eval (ex6 (.const 0) (.const 1)).time (circQueryModel ℚ) + end CircuitQuery + end Prog end Algorithms From 36abc2f2a22f030a99a84016262d1bc943364a1d Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 3 Feb 2026 15:35:06 +0100 Subject: [PATCH 053/176] Done --- Cslib/Algorithms/CircuitProgs.lean | 33 +- Cslib/Algorithms/MergeSort/MergeSort.lean | 439 +++++++++++++++++++--- Cslib/Algorithms/ProgExamples.lean | 94 +++++ Cslib/Algorithms/QueryModel.lean | 59 +-- 4 files changed, 502 insertions(+), 123 deletions(-) diff --git a/Cslib/Algorithms/CircuitProgs.lean b/Cslib/Algorithms/CircuitProgs.lean index 2a9ee6aff..5aaf0a50a 100644 --- a/Cslib/Algorithms/CircuitProgs.lean +++ b/Cslib/Algorithms/CircuitProgs.lean @@ -22,6 +22,14 @@ inductive Circuit (α : Type u) : Type u → Type u where | neg (id : ℕ) (c : Circuit α α) : Circuit α α deriving Repr +def getID (c : Circuit α β) : ℕ := + match c with + | .const id _ => id + | .add id _ _ => id + | .mul id _ _ => id + | .neg id _ => id + + structure CircuitCosts where depth : ℕ size : ℕ @@ -82,6 +90,7 @@ def exCircuit1 : Prog (Circuit Bool) Bool := do let w := mul 3 x y add 4 z w + #eval exCircuit1.eval (circModel Bool) #eval exCircuit1.time (circModel Bool) @@ -90,7 +99,7 @@ def exCircuit2 : Prog (Circuit ℚ) ℚ := do let x := const 0 (1 : ℚ) let y := const 1 (2 : ℚ) let z := add 2 x y - mul 4 z z + mul 3 z z #eval exCircuit2.eval (circModel ℚ) @@ -138,17 +147,21 @@ section CircuitQuery inductive CircuitQuery (α : Type u) : Type u → Type u where | const (x : α) : CircuitQuery α (Circuit α α) - | add (c₁ c₂ : CircuitQuery α (Circuit α α)) : CircuitQuery α (Circuit α α) - | mul (c₁ c₂ : CircuitQuery α (Circuit α α)) : CircuitQuery α (Circuit α α) - | neg (c : CircuitQuery α (Circuit α α)) : CircuitQuery α (Circuit α α) + | add (c₁ c₂ : Circuit α α) : CircuitQuery α (Circuit α α) + | mul (c₁ c₂ : Circuit α α) : CircuitQuery α (Circuit α α) + | neg (c : Circuit α α) : CircuitQuery α (Circuit α α) + +structure CircuitContext (α β : Type u) where + q : CircuitQuery α β + counter : ℕ def circQueryEvalAux (α : Type u) (id : ℕ) (c : CircuitQuery α ι) : ι := match c with | .const x => Circuit.const id x - | .add c₁ c₂ => Circuit.add id (circQueryEvalAux α (id + 1) c₁) (circQueryEvalAux α (id + 2) c₂) - | .mul c₁ c₂ => Circuit.add id (circQueryEvalAux α (id + 1) c₁) (circQueryEvalAux α (id + 2) c₂) - | .neg c => Circuit.neg id (circQueryEvalAux α (id + 1) c) + | .add c₁ c₂ => Circuit.add id c₁ c₂ + | .mul c₁ c₂ => Circuit.mul id c₁ c₂ + | .neg c => Circuit.neg id c def sizeCircQuery (c : CircuitQuery α (Circuit α β)) : CircuitCosts := let c' := circQueryEvalAux α 0 c @@ -169,9 +182,9 @@ def reduceToCirc {α} [iadd : Add α] [imul : Mul α] [ineg : Neg α] open CircuitQuery in def ex5 : Prog (CircuitQuery ℚ) (Circuit ℚ ℚ) := do - let x := const (1 : ℚ) - let y := const (2 : ℚ) - let z := add x y + let x ← const (1 : ℚ) + let y : Circuit ℚ ℚ ← const (2 : ℚ) + let z : Circuit ℚ ℚ ← add x y mul z z diff --git a/Cslib/Algorithms/MergeSort/MergeSort.lean b/Cslib/Algorithms/MergeSort/MergeSort.lean index 3321ee2d7..f15a8efda 100644 --- a/Cslib/Algorithms/MergeSort/MergeSort.lean +++ b/Cslib/Algorithms/MergeSort/MergeSort.lean @@ -6,6 +6,7 @@ Authors: Tanner Duve module +public import Cslib.Algorithms.QueryModel @[expose] public section @@ -26,65 +27,379 @@ We also provide simple example evaluations of `mergeSort` and its time cost. -namespace Cslib.Algorithms.MergeSort.QueryBased - - --- /-- The Model for comparison sorting natural-number registers. --- -/ --- inductive ListSortOps (α : Type) : Type → Type where --- | cmp : (l : List α) → (i j : Fin l.length) → ListSortOps α Bool --- | write : (l : List α) → (i : Fin l.length) → (x : α) → ListSortOps α (List α) --- | read : (l : List α) → (i : Fin l.length) → ListSortOps α α - - --- def ListSort_WorstCase [DecidableEq α] : Model (ListSortOps α) where --- evalQuery q := --- match q with --- | .write l i x => l.set i x --- | .cmp l i j => l[i] == l[j] --- | .read l i => l.get i --- cost q := --- match q with --- | .write l i x => l.length --- | .read l i => l.length --- | .cmp l i j => l.length - - - --- /-- Merge two sorted lists using comparisons in the query monad. -/ --- def merge (x y : List Nat) : Prog (ListSortOps Nat) (List Nat) := do --- match x,y with --- | [], ys => pure ys --- | xs, [] => pure xs --- | x :: xs', y :: ys' => do --- if x ≤ y then --- let rest ← merge xs' (y :: ys') --- pure (x :: rest) --- else --- let rest ← merge (x :: xs') ys' --- pure (y :: rest) - --- /-- Split a list into two lists by alternating elements. -/ --- def split (xs : List Nat) : List Nat × List Nat := --- let rec go : List Nat → List Nat → List Nat → List Nat × List Nat --- | [], accL, accR => (accL.reverse, accR.reverse) --- | [x], accL, accR => ((x :: accL).reverse, accR.reverse) --- | x :: y :: xs, accL, accR => go xs (x :: accL) (y :: accR) --- go xs [] [] - --- /-- Merge sort expressed as a program in the query model. --- TODO: Working version without partial -/ --- partial def mergeSort : List Nat → Prog (ListSortOps Nat) (List Nat) --- | [] => pure [] --- | [x] => pure [x] --- | xs => --- let (left, right) := split xs --- do --- let sortedLeft ← mergeSort left --- let sortedRight ← mergeSort right --- merge sortedLeft sortedRight - --- #eval Prog.eval (mergeSort [5,3,8,6,2,7,4,1]) ListSort_WorstCase --- #eval Prog.time (mergeSort [5,3,8,6,2,7,4,1]) ListSort_WorstCase - -end Cslib.Algorithms.MergeSort.QueryBased +namespace Cslib.Algorithms + +/-- The Model for comparison sorting natural-number registers. +-/ +inductive SortOps (α : Type) : Type → Type where + | cmpLT (x : α) (y : α): SortOps α Bool + | insertHead (l : List α) (x : α) : SortOps α (List α) + +open SortOps + +@[ext] +structure SortOpsCost where + compares : ℕ + inserts : ℕ + pure : ℕ + +@[simp, grind] +instance pcSortOps : PureCosts SortOpsCost where + pureCost := ⟨0,0,1⟩ + +@[simp, grind] +instance zeroSortOps : Zero SortOpsCost := ⟨0,0,0⟩ + +@[simp, grind] +instance addSortOps : Add SortOpsCost where + add | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => ⟨c₁ + c₂, i₁ + i₂, p₁ + p₂⟩ + +@[simp] +instance partialOrderSortOps : PartialOrder SortOpsCost where + le | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ ∧ p₁ ≤ p₂ + le_refl := by + intro c + simp only [le_refl, and_self] + le_trans a b c := by + simp only [and_imp] + intro ab_comps ab_inserts ab_pures bc_comps bc_inserts bc_pures + refine ⟨?_, ?_, ?_⟩ + all_goals solve_by_elim [Nat.le_trans] + le_antisymm := by + intro ⟨a_comps, a_inserts, a_pures⟩ ⟨b_comps, b_inserts, b_pures⟩ + simp only [SortOpsCost.mk.injEq, and_imp] + intro ab_comps ab_inserts ab_pures ba_comps ba_inserts ba_pures + refine ⟨?_, ?_, ?_⟩ + all_goals solve_by_elim[Nat.le_antisymm] + + +@[simp, grind] +def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where + evalQuery q := + match q with + | .cmpLT x y => + if x < y then + true + else + false + | .insertHead l x => x :: l + cost q := + match q with + | .cmpLT _ _ => ⟨1,0,0⟩ + | .insertHead _ _ => ⟨0,1,0⟩ + +lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : + (sortModel α).evalQuery (cmpLT x y) ↔ x < y := by + simp [sortModel] + +lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : + (sortModel α).evalQuery (insertHead l x) = x :: l := by + simp [sortModel] + +lemma SortModel_addComponents [LinearOrder α] (m₁ m₂ m₃ : SortOpsCost) : + m₁ + m₂ = m₃ ↔ + m₁.compares + m₂.compares = m₃.compares ∧ + m₁.inserts + m₂.inserts = m₃.inserts ∧ + m₁.pure + m₂.pure = m₃.pure := by + simp only [HAdd.hAdd, addSortOps] + simp only [instAddNat, Nat.add_eq] + aesop + +lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : + m₁ ≤ m₂ ↔ + m₁.compares ≤ m₂.compares ∧ + m₁.inserts ≤ m₂.inserts ∧ + m₁.pure ≤ m₂.pure := by + simp only [LE.le] + +def insertOrd' (l : List α) [LinearOrder α] (x : α) := + match l with + | [] => [x] + | a :: as => if a < x then insertOrd' as x else x :: (a :: as) + + +def insertOrd (l : List α) (x : α) : Prog (SortOps α) (List α) := do + match l with + | [] => insertHead l x + | a :: as => + let cmp : Bool ← cmpLT a x + if cmp + then + insertOrd as x + else + insertHead (a :: as) x + +lemma insertOrd_is_insertOrd' [LinearOrder α] : + ∀ (l : List α) (x : α), + (insertOrd l x).eval (sortModel α) = insertOrd' l x := by + intro l x + induction l with + | nil => + simp_all [insertOrd, insertOrd', Id.run] + | cons head tail ih => + simp_all only [Prog.eval, Id.run, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + Bool.if_false_right, Bool.and_true, insertOrd, bind, FreeM.lift_def, FreeM.liftBind_bind, + FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq, insertOrd'] + split_ifs with h_head + · exact ih + · simp + + +lemma insertOrd_complexity [LinearOrder α] : + ∀ (l : List α) (x : α), + (insertOrd l x).time (sortModel α) ≤ ⟨l.length, 1, 1⟩ := by + intro l x + induction l with + | nil => + simp_all [sortModel, insertOrd, Prog.time, PureCosts.pureCost, HAdd.hAdd, addSortOps] + | cons head tail ih => + simp only [insertOrd, bind, FreeM.lift_def, FreeM.liftBind_bind, FreeM.pure_bind, Prog.time, + List.length_cons] + by_cases h_head : head < x + · split_ifs + all_goals + simp only at ih + have h₁ : (⟨tail.length + 1, 1, 1⟩ : SortOpsCost) = ⟨1,0,0⟩ + ⟨tail.length, 1, 1⟩ := by + simp only [HAdd.hAdd, addSortOps, SortOpsCost.mk.injEq, and_self, and_true] + simp only [instAddNat, Nat.add_eq, Nat.add_comm] + rw [h₁] + rw [SortModel_leComponents] at * + refine ⟨?_, ?_, ?_⟩ + all_goals + clear h₁ + apply Nat.add_le_add + · simp + · --replace ih := ih.1 + simp [-sortModel] at ih + grind + · simp only [sortModel, Bool.if_false_right, Bool.and_true, decide_eq_true_eq] + split_ifs + · simp only [partialOrderSortOps, not_and, not_le, addSortOps, Prog.time, + PureCosts.pureCost] + refine ⟨?_, ?_, ?_⟩ + · simp only [HAdd.hAdd] + simp only [instAddNat, Nat.add_eq, add_zero, le_add_iff_nonneg_left, zero_le] + · simp only [HAdd.hAdd] + simp only [instAddNat, Nat.add_eq, add_zero, zero_add, le_refl] + · simp only [HAdd.hAdd, le_refl] + + +lemma List_Monotone_tail [LinearOrder α] (l : List α) (x : α) : + Monotone (x :: l).get → Monotone l.get := by + intro h + simp_all only [Monotone, List.length_cons, List.get_eq_getElem] + intro i j hij + have : i.castSucc + 1 ≤ j.castSucc + 1 := by + simp only [Fin.coeSucc_eq_succ, Fin.succ_le_succ_iff] + exact hij + specialize @h (i.castSucc + 1) (j.castSucc + 1) this + simp_all only [Fin.coeSucc_eq_succ, Fin.val_succ, List.getElem_cons_succ] + +lemma List.cons_get_pred_get (l : List α) (x : α) + (i : Fin (x :: l).length) (hi : i > ⟨0, by grind⟩) : + (x :: l).get i = l.get (i.pred (by aesop)) := by + grind + +lemma List_Monotone_of_cons [LinearOrder α] (tail : List α) (head : α) : + Monotone (head :: tail).get ↔ Monotone tail.get ∧ ∀ y ∈ tail, head ≤ y := by + constructor + · intro mono + constructor + · apply List_Monotone_tail at mono + assumption + · intro y y_tail + obtain ⟨i,hi⟩ := List.get_of_mem y_tail + simp only [Monotone, List.length_cons, List.get_eq_getElem] at mono + specialize @mono 0 (i.castSucc + 1) (by simp) + simp_all + · intro ⟨htail_mono, h_head⟩ i j hij + by_cases hi_eq_j : i = j + · rw [hi_eq_j] + · apply Std.lt_of_le_of_ne at hij + apply hij at hi_eq_j + have s₁ : ⟨0, by grind⟩ < j := by + grind + have s₂ : (head :: tail).get j ∈ tail := by + grind + by_cases hi_zero : i = ⟨0, by grind⟩ + · rw [hi_zero] + simp only [List.length_cons, Fin.zero_eta, List.get_eq_getElem, Fin.coe_ofNat_eq_mod, + Nat.zero_mod, List.getElem_cons_zero, ge_iff_le] + specialize h_head (head :: tail)[↑j] s₂ + exact h_head + · have s₃ : i > ⟨0, by grind⟩ := by + grind + rw [List.cons_get_pred_get, List.cons_get_pred_get] + · apply htail_mono + grind + · exact s₁ + · exact s₃ + + + + + +lemma List_Monotone_cons [LinearOrder α] (tail : List α) (x head : α) + (hx : x ≤ head) (h_mono : Monotone (head :: tail).get) : Monotone (x :: head :: tail).get := by + have s₁ : ∀ y ∈ tail, head ≤ y := by + intro x x_in_tail + simp_all [Monotone] + obtain ⟨i, hi⟩ := List.get_of_mem x_in_tail + specialize @h_mono 0 (i.castSucc + 1) (by simp) + simp at h_mono + simp_all + rw [List_Monotone_of_cons] + simp only [List.length_cons, List.mem_cons, forall_eq_or_imp] + constructor + · exact h_mono + · constructor + · grind + · intro y y_in_tail + specialize s₁ y y_in_tail + grind + + +lemma insertOrd'_sorted [LinearOrder α] (l : List α) (x : α) : + Monotone l.get → Monotone (insertOrd' l x).get := by + intro l_mono + induction l with + | nil => + simp_all [Monotone] + | cons head tail ih => + have ltail_mono := List_Monotone_tail tail head l_mono + specialize ih ltail_mono + simp only [insertOrd'] + split_ifs with h_head + · grind + · apply List_Monotone_cons at l_mono + case x => exact x + all_goals grind + + +lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : + Monotone l.get → Monotone ((insertOrd l x).eval (sortModel α)).get := by + intro l_mono + rw [insertOrd_is_insertOrd' l x] + induction l with + | nil => + simp[Monotone] + | cons head tail ih => + specialize ih (List_Monotone_tail tail head l_mono) + simp only [insertOrd'] + split_ifs with h_head + · grind + · intro i j hij + simp only [h_head, List.get_eq_getElem, ↓reduceIte] + apply List_Monotone_cons + · grind + · exact l_mono + · grind + + + +/-- Merge two sorted lists using comparisons in the query monad. -/ +def mergeNaive [LinearOrder α] (x y : List α) : List α := + match x,y with + | [], ys => ys + | xs, [] => xs + | x :: xs', y :: ys' => + if x < y then + let rest := mergeNaive xs' (y :: ys') + x :: rest + else + let rest := mergeNaive (x :: xs') ys' + y :: rest + +/-- Merge two sorted lists using comparisons in the query monad. -/ +@[simp, grind] +def merge (x y : List α) : Prog (SortOps α) (List α) := do + match x,y with + | [], ys => return ys + | xs, [] => return xs + | x :: xs', y :: ys' => do + let cmp : Bool ← cmpLT 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_is_mergeNaive [LinearOrder α] (x y : List α) : + (merge x y).eval (sortModel α) = mergeNaive x y := by + fun_induction mergeNaive + · simp [merge, Id.run] + · expose_names + simp [Id.run] + · expose_names + simp only [Prog.eval, Id.run, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + Bool.if_false_right, Bool.and_true, merge, bind, FreeM.lift_def, FreeM.liftBind_bind, + FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq] + simp_all only [Prog.eval, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + Bool.if_false_right, Bool.and_true, ↓reduceIte, FreeM.liftM_bind, bind, + FreeM.liftM_pure, List.cons.injEq, true_and, rest] + exact ih1 + · simp only [Prog.eval, Id.run, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + Bool.if_false_right, Bool.and_true, merge, bind, FreeM.lift_def, FreeM.liftBind_bind, + FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq] + rename_i rest ih1 + simp_all only [not_lt, Prog.eval, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + Bool.if_false_right, Bool.and_true, rest] + split + next h_1 => + simp_all only [FreeM.liftM_bind, bind, FreeM.liftM_pure, pure, List.cons.injEq] + apply And.intro + · grind + · grind + next + h_1 => + simp_all only [not_lt, FreeM.liftM_bind, bind, FreeM.liftM_pure, pure, List.cons.injEq, + true_and] + exact ih1 + +lemma mergeNaive_sorted_sorted [LinearOrder α] (xs ys : List α) + (hxs_mono : Monotone xs.get) (hys_mono : Monotone ys.get) : + Monotone (mergeNaive xs ys).get := by + fun_induction mergeNaive + · simp_all + · simp_all + · rename_i rest ih1 + expose_names + simp_all only [List.length_cons, forall_const, rest] + specialize ih1 (List_Monotone_tail xs' x hxs_mono) + + sorry + · rename_i rest ih1 + expose_names + simp_all only [not_lt, List.length_cons, forall_const, rest] + specialize ih1 (List_Monotone_tail ys' y hys_mono) + + sorry + +/-- Split a list into two lists by alternating elements. -/ +def split (xs : List Nat) : List Nat × List Nat := + let rec go : List Nat → List Nat → List Nat → List Nat × List Nat + | [], accL, accR => (accL.reverse, accR.reverse) + | [x], accL, accR => ((x :: accL).reverse, accR.reverse) + | x :: y :: xs, accL, accR => go xs (x :: accL) (y :: accR) + go xs [] [] + +/-- Merge sort expressed as a program in the query model. +TODO: Working version without partial -/ +partial def mergeSort : List Nat → Prog (SortOps Nat) (List Nat) + | [] => pure [] + | [x] => pure [x] + | xs => + let (left, right) := split xs + do + let sortedLeft ← mergeSort left + let sortedRight ← mergeSort right + merge sortedLeft sortedRight + +#eval (mergeSort [5,3,8,6,2,7,4,1]).eval (sortModel Nat) +#eval (mergeSort [5,3,8,6,2,7,4,1]).time (sortModel Nat) + + + + +end Cslib.Algorithms diff --git a/Cslib/Algorithms/ProgExamples.lean b/Cslib/Algorithms/ProgExamples.lean index 41e497c82..80556828f 100644 --- a/Cslib/Algorithms/ProgExamples.lean +++ b/Cslib/Algorithms/ProgExamples.lean @@ -382,6 +382,100 @@ lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Non end ListLinearSearch + +section ListBinarySearch +inductive ListBinSearch (α : Type) : Type → Type where + | compare (a : List α) (i : Fin a.length) (val : α) : ListBinSearch α Ordering + + +def ListBinSearch_Nat [LinearOrder α] : Model (ListBinSearch α) ℕ where + evalQuery q := + match q with + | .compare l i x => + if l[i]? = some x + then Ordering.eq + else + if l[i]? < some x + then Ordering.lt + else + Ordering.gt + cost q := + match q with + | .compare _ _ _ => 1 + + +def ListBinSearch_Cmp [DecidableEq α] : Model (ListBinSearch α) CmpCount where + evalQuery q := + match q with + | .compare l i x => l[i]? == some x + cost q := + match q with + | .compare _ _ _ => ⟨1,0⟩ + +open ListSearch in +def listBinarySearchAux (l : List α) (x : α) (lo hi : Fin l.length) : Prog (ListBinSearch α) Bool := do + let mid : Fin l.length := (lo + hi) / 2 + if compare l mid x then + return true + else + if comp +lemma listBinarySearchM_correct_true [iDec : DecidableEq α] (l : List α) : + ∀ x : α, x ∈ l → (listLinearSearch l x).eval ListSearch_Nat = true := by + intro x x_mem_l + induction l with + | nil => + simp_all only [List.not_mem_nil] + | cons head tail ih => + simp_all only [List.mem_cons, listLinearSearch, bind, FreeM.lift_def, pure, + FreeM.liftBind_bind, FreeM.pure_bind, eval] + split_ifs with h + · simp [eval] + · obtain (x_head | xtail) := x_mem_l + · rw [x_head] at h + simp[ListSearch_Nat] at h + · specialize ih xtail + exact ih + +lemma listBinarySearchM_correct_false [DecidableEq α] (l : List α) : + ∀ x : α, x ∉ l → (listLinearSearch l x).eval ListSearch_Nat = false := by + intro x x_mem_l + induction l with + | nil => + simp_all [listLinearSearch, eval] + | cons head tail ih => + simp only [List.mem_cons, not_or] at x_mem_l + specialize ih x_mem_l.2 + simp only [listLinearSearch, bind, FreeM.lift_def, pure, FreeM.liftBind_bind, FreeM.pure_bind, + eval] + split_ifs with h_eq + · simp [ListSearch_Nat] at h_eq + exfalso + exact x_mem_l.1 h_eq.symm + · exact ih + + + +lemma listBinarySearchM_time_complexity_upper_bound [DecidableEq α] (l : List α) : + ∀ x : α, (listLinearSearch l x).time ListSearch_Nat ≤ 1 + l.length := by + intro x + induction l with + | nil => + simp_all [listLinearSearch, ListSearch_Nat, time, PureCosts.pureCost] + | cons head tail ih => + simp_all [listLinearSearch, ListSearch_Nat, time] + split_ifs with h_head + · simp [time, PureCosts.pureCost] + · grind + +lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Nontrivial α] : + ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = 1 + l.length := by + obtain ⟨x, y, x_neq_y⟩ := inon + use [x,x,x,x,x,y], y + simp_all [time, ListSearch_Nat, listLinearSearch, PureCosts.pureCost] + + +end ListBinarySearch + end ProgExamples end Prog diff --git a/Cslib/Algorithms/QueryModel.lean b/Cslib/Algorithms/QueryModel.lean index c53dcdf07..a591f7f3a 100644 --- a/Cslib/Algorithms/QueryModel.lean +++ b/Cslib/Algorithms/QueryModel.lean @@ -46,9 +46,7 @@ and complexity of algorithms in lean. To specify an algorithm, one must: query model, free monad, time complexity, Prog -/ -namespace Cslib - -namespace Algorithms +namespace Cslib.Algorithms class PureCosts (α : Type u) where pureCost : α @@ -65,18 +63,14 @@ abbrev Prog Q α := FreeM Q α instance {Q α} : Coe (Q α) (FreeM Q α) where coe := FreeM.lift -namespace Prog - -def eval [Add Cost] [Zero Cost] [PureCosts Cost] +@[simp, grind] +def Prog.eval [Add Cost] [Zero Cost] [PureCosts Cost] (P : Prog Q α) (M : Model Q Cost) : α := - match P with - | .pure x => x - | .liftBind op cont => - let qval := M.evalQuery op - eval (cont qval) M + Id.run <| P.liftM fun x => pure (M.evalQuery x) -def time [Add Cost] [Zero Cost] [PureCosts Cost] +@[simp, grind] +def Prog.time [Add Cost] [Zero Cost] [PureCosts Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := match P with | .pure _ => PureCosts.pureCost @@ -85,52 +79,15 @@ def time [Add Cost] [Zero Cost] [PureCosts Cost] let qval := M.evalQuery op t₁ + (time (cont qval) M) -section TimeM - --- The below is a proof of concept and pointless -def interpretQueryIntoTime (M : Model Q ℕ) (q : Q α) : TimeM α where - ret := M.evalQuery q - time := M.cost q - -def interpretProgIntoTime (P : Prog Q α) (M : Model Q ℕ) : TimeM α where - ret := eval P M - time := time P M - -def liftProgIntoTime (M : Model Q ℕ) (P : Prog Q α) : TimeM α := - P.liftM (interpretQueryIntoTime M) - - --- The below lemma only holds if the cost of pure operations is zero. This --- is however a footgun - --- -- This lemma is a sanity check. This is the only place `TimeM` is used. --- lemma timing_is_identical : ∀ (P : Prog Q α) (M : Model Q ℕ), --- time P M = (liftProgIntoTime M P).time := by --- intro P pm --- induction P with --- | pure a => --- simp [time,liftProgIntoTime] --- | liftBind op cont ih => --- expose_names --- simp_all [time, liftProgIntoTime, interpretQueryIntoTime] - -end TimeM - - - section Reduction structure Reduction (Q₁ Q₂ : Type u → Type u) where reduce : Q₁ α → Prog Q₂ α -def reduceProg (P : Prog Q₁ α) (red : Reduction Q₁ Q₂) : Prog Q₂ α := +def Prog.reduceProg (P : Prog Q₁ α) (red : Reduction Q₁ Q₂) : Prog Q₂ α := P.liftM red.reduce end Reduction -end Prog - -end Algorithms - -end Cslib +end Cslib.Algorithms From 72d96fcabb388d9fce1854538858ef7c523905f9 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 3 Feb 2026 16:03:13 +0100 Subject: [PATCH 054/176] Circuits works --- Cslib/Algorithms/CircuitProgs.lean | 242 ++++++++++++++--------------- 1 file changed, 120 insertions(+), 122 deletions(-) diff --git a/Cslib/Algorithms/CircuitProgs.lean b/Cslib/Algorithms/CircuitProgs.lean index 5aaf0a50a..73a5cb9a3 100644 --- a/Cslib/Algorithms/CircuitProgs.lean +++ b/Cslib/Algorithms/CircuitProgs.lean @@ -15,193 +15,191 @@ namespace Cslib namespace Algorithms namespace Prog -inductive Circuit (α : Type u) : Type u → Type u where - | const (id : ℕ) (x : α) : Circuit α α - | add (id : ℕ) (c₁ c₂ : Circuit α α) : Circuit α α - | mul (id : ℕ) (c₁ c₂ : Circuit α α) : Circuit α α - | neg (id : ℕ) (c : Circuit α α) : Circuit α α +inductive Formula (α : Type u) : Type u → Type u where + | const (x : α) : Formula α α + | add (c₁ c₂ : Formula α α) : Formula α α + | mul (c₁ c₂ : Formula α α) : Formula α α + | neg (c : Formula α α) : Formula α α deriving Repr -def getID (c : Circuit α β) : ℕ := - match c with - | .const id _ => id - | .add id _ _ => id - | .mul id _ _ => id - | .neg id _ => id +-- def getID (c : Formula α β) : ℕ := +-- match c with +-- | .const id _ => id +-- | .add id _ _ => id +-- | .mul id _ _ => id +-- | .neg id _ => id structure CircuitCosts where depth : ℕ size : ℕ - nodeIDList : List ℕ instance : PureCosts CircuitCosts where - pureCost := ⟨0,0, []⟩ + pureCost := ⟨0,0⟩ instance : Zero CircuitCosts where - zero := ⟨0,0, []⟩ + zero := ⟨0,0⟩ instance : Add CircuitCosts where - add x y := ⟨x.1 + y.1, x.2 + y.2, x.3 ++ y.3⟩ + add x y := ⟨x.1 + y.1, x.2 + y.2⟩ -def circEval (α : Type u) [Add α] [Mul α] [Neg α] (c : Circuit α ι) : ι := +def circEval (α : Type u) [Add α] [Mul α] [Neg α] (c : Formula α ι) : ι := match c with - | .const _ x => x - | .add _ c₁ c₂ => circEval α c₁ + circEval α c₂ - | .mul _ c₁ c₂ => circEval α c₁ * circEval α c₂ - | .neg _ c => - circEval α c + | .const x => x + | .add c₁ c₂ => circEval α c₁ + circEval α c₂ + | .mul c₁ c₂ => circEval α c₁ * circEval α c₂ + | .neg c => - circEval α c -def depthOf (q : Circuit α β) := +def depthOf (q : Formula α β) := match q with - | .const _ c => 0 - | .add _ c₁ c₂ => 1 + max (depthOf c₁) (depthOf c₂) - | .mul _ c₁ c₂ => 1 + max (depthOf c₁) (depthOf c₂) - | .neg _ c => 1 + depthOf c - -def uniqueIDs (q : Circuit α β) (countedIDs : List ℕ) : List ℕ := + | .const c => 0 + | .add c₁ c₂ => 1 + max (depthOf c₁) (depthOf c₂) + | .mul c₁ c₂ => 1 + max (depthOf c₁) (depthOf c₂) + | .neg c => 1 + depthOf c + +-- def uniqueIDs (q : Formula α β) (countedIDs : List ℕ) : List ℕ := +-- match q with +-- | .const id _ => +-- countedIDs.insert id +-- | .add id x y => +-- let s₁ := uniqueIDs x countedIDs +-- let s₂ := uniqueIDs y s₁ +-- s₂.insert id +-- | .mul id x y => +-- let s₁ := uniqueIDs x countedIDs +-- let s₂ := uniqueIDs y s₁ +-- s₂.insert id +-- | .neg id x => +-- let s := uniqueIDs x countedIDs +-- s.insert id + +def sizeOf (q : Formula α β) := match q with - | .const id _ => - countedIDs.insert id - | .add id x y => - let s₁ := uniqueIDs x countedIDs - let s₂ := uniqueIDs y s₁ - s₂.insert id - | .mul id x y => - let s₁ := uniqueIDs x countedIDs - let s₂ := uniqueIDs y s₁ - s₂.insert id - | .neg id x => - let s := uniqueIDs x countedIDs - s.insert id - -def sizeOf (q : Circuit α β) := (uniqueIDs q []).length - -def circModel (α : Type u) [Add α] [Mul α] [Neg α] : Model (Circuit α) CircuitCosts where + | .const c => 0 + | .add c₁ c₂ => 1 + max (depthOf c₁) (depthOf c₂) + | .mul c₁ c₂ => 1 + max (depthOf c₁) (depthOf c₂) + | .neg c => 1 + depthOf c + +def circModel (α : Type u) [Add α] [Mul α] [Neg α] : Model (Formula α) CircuitCosts where evalQuery q := circEval α q - cost q := ⟨depthOf q, sizeOf q, uniqueIDs q []⟩ + cost q := ⟨depthOf q, sizeOf q⟩ -open Circuit in -def exCircuit1 : Prog (Circuit Bool) Bool := do - let x := const 0 true - let y := const 1 true - let z := add 2 x y - let w := mul 3 x y - add 4 z w +open Formula in +def exFormula1 : Prog (Formula Bool) Bool := do + let x := const true + let y := const true + let z := add x y + let w := mul x y + add z w -#eval exCircuit1.eval (circModel Bool) -#eval exCircuit1.time (circModel Bool) +#eval exFormula1.eval (circModel Bool) +#eval exFormula1.time (circModel Bool) -open Circuit in -def exCircuit2 : Prog (Circuit ℚ) ℚ := do - let x := const 0 (1 : ℚ) - let y := const 1 (2 : ℚ) - let z := add 2 x y - mul 3 z z +open Formula in +def exFormula2 : Prog (Formula ℚ) ℚ := do + let x := const (1 : ℚ) + let y := const (2 : ℚ) + let z := add x y + mul z z -#eval exCircuit2.eval (circModel ℚ) -#eval exCircuit2.time (circModel ℚ) +#eval exFormula2.eval (circModel ℚ) +#eval exFormula2.time (circModel ℚ) -open Circuit in -def exCircuit3 : Prog (Circuit ℚ) ℚ := do - let x := const 0 (1 : ℚ) - let y := const 1 (2 : ℚ) - let z := add 2 x y - mul 4 z z +open Formula in +def exFormula3 : Prog (Formula ℚ) ℚ := do + let x := const (1 : ℚ) + let y := const (2 : ℚ) + let z := add x y + mul z z -#eval exCircuit2.eval (circModel ℚ) -#eval exCircuit2.time (circModel ℚ) +#eval exFormula2.eval (circModel ℚ) +#eval exFormula2.time (circModel ℚ) -open Circuit in -def exCircuit4 (x y : Circuit ℚ ℚ) : Prog (Circuit ℚ) ℚ := do - let z := add 2 x y - let w := mul 3 x y - mul 4 z w +open Formula in +def exFormula4 (x y : Formula ℚ ℚ) : Prog (Formula ℚ) ℚ := do + let z := add x y + let w := mul x y + mul z w -#eval (exCircuit4 (.const 0 (1 : ℚ)) (.const 1 (21 : ℚ))).eval (circModel ℚ) -#eval (exCircuit4 (.const 0 (1 : ℚ)) (.const 1 (21 : ℚ))).time (circModel ℚ) +#eval (exFormula4 (.const (1 : ℚ)) (.const (21 : ℚ))).eval (circModel ℚ) +#eval (exFormula4 (.const (1 : ℚ)) (.const (21 : ℚ))).time (circModel ℚ) -open Circuit in -def CircAnd (n : ℕ) (x : Fin n → Circuit Bool Bool) : Circuit Bool Bool := +open Formula in +def CircAnd (n : ℕ) (x : Fin n → Formula Bool Bool) : Formula Bool Bool := match n with - | 0 => const n true + | 0 => const true | m + 1 => let x_head := x 0 let x_cons := CircAnd m (Fin.tail x) - mul (n + m + 1) x_head x_cons + mul x_head x_cons -def execCircAnd (x : Fin n → Circuit Bool Bool) : Prog (Circuit Bool) Bool := do +def execCircAnd (x : Fin n → Formula Bool Bool) : Prog (Formula Bool) Bool := do CircAnd n x -#eval (execCircAnd ![.const 0 true, .const 1 true, .const 2 true]).eval (circModel Bool) -#eval (execCircAnd ![.const 0 true, .const 1 true, .const 2 true]).time (circModel Bool) +#eval (execCircAnd ![.const true, .const true, .const true]).eval (circModel Bool) +#eval (execCircAnd ![.const true, .const true, .const true]).time (circModel Bool) -section CircuitQuery +section Circuit -- Another query type that reduces to Circuit queries. automates identification of nodes -inductive CircuitQuery (α : Type u) : Type u → Type u where - | const (x : α) : CircuitQuery α (Circuit α α) - | add (c₁ c₂ : Circuit α α) : CircuitQuery α (Circuit α α) - | mul (c₁ c₂ : Circuit α α) : CircuitQuery α (Circuit α α) - | neg (c : Circuit α α) : CircuitQuery α (Circuit α α) +inductive Circuit (α : Type u) : Type u → Type u where + | const (x : α) : Circuit α (Formula α α) + | add (c₁ c₂ : Formula α α) : Circuit α (Formula α α) + | mul (c₁ c₂ : Formula α α) : Circuit α (Formula α α) + | neg (c : Formula α α) : Circuit α (Formula α α) + -structure CircuitContext (α β : Type u) where - q : CircuitQuery α β - counter : ℕ -def circQueryEvalAux (α : Type u) (id : ℕ) - (c : CircuitQuery α ι) : ι := +def circQueryEvalAux (α : Type u) + (c : Circuit α ι) : ι := match c with - | .const x => Circuit.const id x - | .add c₁ c₂ => Circuit.add id c₁ c₂ - | .mul c₁ c₂ => Circuit.mul id c₁ c₂ - | .neg c => Circuit.neg id c + | .const x => Formula.const x + | .add c₁ c₂ => Formula.add c₁ c₂ + | .mul c₁ c₂ => Formula.mul c₁ c₂ + | .neg c => Formula.neg c -def sizeCircQuery (c : CircuitQuery α (Circuit α β)) : CircuitCosts := - let c' := circQueryEvalAux α 0 c - ⟨depthOf c', sizeOf c', uniqueIDs c' []⟩ +def sizeCircQuery (c : Circuit α (Formula α β)) : CircuitCosts := + let c' := circQueryEvalAux α c + ⟨depthOf c', sizeOf c'⟩ -def circQueryModel (α : Type u) [Add α] [Mul α] [Neg α] : Model (CircuitQuery α) CircuitCosts where - evalQuery q := circQueryEvalAux α 0 q +def circQueryModel (α : Type u) [Add α] [Mul α] [Neg α] : Model (Circuit α) CircuitCosts where + evalQuery q := circQueryEvalAux α q cost q := match q with | .const x => sizeCircQuery (.const x) | .add c₁ c₂ => sizeCircQuery (.add c₁ c₂) | .mul c₁ c₂ => sizeCircQuery (.mul c₁ c₂) | .neg c => sizeCircQuery (.neg c) - -def reduceToCirc {α} [iadd : Add α] [imul : Mul α] [ineg : Neg α] - (P : Prog (CircuitQuery α) (Circuit α α)) : Prog (Circuit α) α := do - P.eval (circQueryModel α) - -open CircuitQuery in -def ex5 : Prog (CircuitQuery ℚ) (Circuit ℚ ℚ) := do +open Circuit in +def ex5 : Prog (Circuit ℚ) (Formula ℚ ℚ) := do let x ← const (1 : ℚ) - let y : Circuit ℚ ℚ ← const (2 : ℚ) - let z : Circuit ℚ ℚ ← add x y - mul z z - + let y : Formula ℚ ℚ ← const (2 : ℚ) + let z : Formula ℚ ℚ ← add x y + let w : Formula ℚ ℚ ← mul z z + return w #eval ex5.eval (circQueryModel ℚ) #eval ex5.time (circQueryModel ℚ) -open CircuitQuery in -def ex6 (a b : CircuitQuery ℚ (Circuit ℚ ℚ)) : Prog (CircuitQuery ℚ) (Circuit ℚ ℚ) := do - let x := a - let y := b - let z := add x y +open Circuit in +def ex6 (a b : Circuit ℚ (Formula ℚ ℚ)) : Prog (Circuit ℚ) (Formula ℚ ℚ) := do + let x : Formula ℚ ℚ ← a + let y : Formula ℚ ℚ ← b + let z : Formula ℚ ℚ ← add x y mul z z -#eval (ex6 (.const 0) (.const 1)).eval (circQueryModel ℚ) +def ex6_circuit := (ex6 (.const 0) (.const 1)).eval (circQueryModel ℚ) +#eval sizeOf ex6_circuit #eval (ex6 (.const 0) (.const 1)).time (circQueryModel ℚ) -end CircuitQuery +end Circuit end Prog From d472ff51419c7647457912d60f941264eee9f4b8 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 3 Feb 2026 16:05:06 +0100 Subject: [PATCH 055/176] Circuits works --- Cslib/Algorithms/CircuitProgs.lean | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Cslib/Algorithms/CircuitProgs.lean b/Cslib/Algorithms/CircuitProgs.lean index 73a5cb9a3..6231b9563 100644 --- a/Cslib/Algorithms/CircuitProgs.lean +++ b/Cslib/Algorithms/CircuitProgs.lean @@ -76,10 +76,10 @@ def depthOf (q : Formula α β) := def sizeOf (q : Formula α β) := match q with - | .const c => 0 - | .add c₁ c₂ => 1 + max (depthOf c₁) (depthOf c₂) - | .mul c₁ c₂ => 1 + max (depthOf c₁) (depthOf c₂) - | .neg c => 1 + depthOf c + | .const c => 1 + | .add c₁ c₂ => 1 + (sizeOf c₁) + (sizeOf c₂) + | .mul c₁ c₂ => 1 + (sizeOf c₁) + (sizeOf c₂) + | .neg c => 1 + sizeOf c def circModel (α : Type u) [Add α] [Mul α] [Neg α] : Model (Formula α) CircuitCosts where evalQuery q := circEval α q @@ -195,8 +195,8 @@ def ex6 (a b : Circuit ℚ (Formula ℚ ℚ)) : Prog (Circuit ℚ) (Formula ℚ let z : Formula ℚ ℚ ← add x y mul z z -def ex6_circuit := (ex6 (.const 0) (.const 1)).eval (circQueryModel ℚ) -#eval sizeOf ex6_circuit +def ex6_formula : Formula ℚ ℚ := (ex6 (.const 0) (.const 1)).eval (circQueryModel ℚ) +#eval sizeOf ex6_formula #eval (ex6 (.const 0) (.const 1)).time (circQueryModel ℚ) end Circuit From c965ec7d6ef3e5f513586c2168579719ea0ea9d2 Mon Sep 17 00:00:00 2001 From: Shrys Date: Thu, 5 Feb 2026 21:24:55 +0100 Subject: [PATCH 056/176] Update MergeSort.lean Co-authored-by: Eric Wieser --- Cslib/Algorithms/MergeSort/MergeSort.lean | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Cslib/Algorithms/MergeSort/MergeSort.lean b/Cslib/Algorithms/MergeSort/MergeSort.lean index f15a8efda..f47796056 100644 --- a/Cslib/Algorithms/MergeSort/MergeSort.lean +++ b/Cslib/Algorithms/MergeSort/MergeSort.lean @@ -75,8 +75,7 @@ instance partialOrderSortOps : PartialOrder SortOpsCost where @[simp, grind] def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where - evalQuery q := - match q with + evalQuery | .cmpLT x y => if x < y then true From 0a8316d7a9d8b86982eebb4302887e3782042cc4 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 14 Feb 2026 19:53:02 +0100 Subject: [PATCH 057/176] Organise: --- Cslib.lean | 9 +- Cslib/Algorithms/CircuitLineProgs.lean | 135 ------ Cslib/Algorithms/CircuitProgs.lean | 208 --------- Cslib/Algorithms/MergeSort/MergeSort.lean | 405 ------------------ .../Algorithms/ListInsertionSort.lean | 0 .../Algorithms/ListLinearSearch.lean | 120 ++++++ .../Algorithms/ListOrderedInsert.lean | 212 +++++++++ .../Algorithms/MergeSort.lean | 269 ++++++++++++ .../Lean/MergeSort/MergeSort.lean | 0 .../Lean/TimeM.lean | 0 .../QueryModel.lean | 0 .../StandardModels/ParametricWordRAM.lean | 0 Cslib/AlgorithmsTheory/UpstreamLemmas.lean | 90 ++++ .../QueryModel}/ProgExamples.lean | 2 +- .../QueryModel}/QueryExamples.lean | 2 +- 15 files changed, 698 insertions(+), 754 deletions(-) delete mode 100644 Cslib/Algorithms/CircuitLineProgs.lean delete mode 100644 Cslib/Algorithms/CircuitProgs.lean delete mode 100644 Cslib/Algorithms/MergeSort/MergeSort.lean 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 (100%) rename Cslib/{Algorithms => AlgorithmsTheory}/Lean/TimeM.lean (100%) rename Cslib/{Algorithms => AlgorithmsTheory}/QueryModel.lean (100%) create mode 100644 Cslib/AlgorithmsTheory/StandardModels/ParametricWordRAM.lean create mode 100644 Cslib/AlgorithmsTheory/UpstreamLemmas.lean rename {Cslib/Algorithms => CslibTests/QueryModel}/ProgExamples.lean (99%) rename {Cslib/Algorithms => CslibTests/QueryModel}/QueryExamples.lean (97%) diff --git a/Cslib.lean b/Cslib.lean index f19f812e7..04dc987b1 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,9 +1,10 @@ module -public import Cslib.Algorithms.MergeSort.MergeSort -public import Cslib.Algorithms.QueryModel -public import Cslib.Algorithms.Lean.MergeSort.MergeSort -public import Cslib.Algorithms.Lean.TimeM +public import Cslib.AlgorithmsTheory.Algorithms.MergeSort +public import Cslib.AlgorithmsTheory.Models.ParametricWordRAM +public import Cslib.AlgorithmsTheory.QueryModel +public import Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort +public import Cslib.AlgorithmsTheory.Lean.TimeM 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/Algorithms/CircuitLineProgs.lean b/Cslib/Algorithms/CircuitLineProgs.lean deleted file mode 100644 index 398bb76cd..000000000 --- a/Cslib/Algorithms/CircuitLineProgs.lean +++ /dev/null @@ -1,135 +0,0 @@ -/- -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.Algorithms.QueryModel - -@[expose] public section - -namespace Cslib - -namespace Algorithms - -namespace Prog -inductive Circuit (n : ℕ) (α : Type u) : Type u → Type u where - | const (x : α) : Circuit n α α - | add (c₁ c₂ : Fin n) : Circuit n α α - | mul (c₁ c₂ : Fin n) : Circuit n α α - | neg (c : Fin n) : Circuit n α α - -structure CircuitLines (n : ℕ) (α ι : Type u) : Type u where - circuits : (i : Fin n) → Circuit i ι ι - -structure CircuitCosts where - depth : ℕ - size : ℕ - nodeIDList : List ℕ - -instance : PureCosts CircuitCosts where - pureCost := ⟨0,0, []⟩ - -instance : Zero CircuitCosts where - zero := ⟨0,0, []⟩ - -instance : Add CircuitCosts where - add x y := ⟨x.1 + y.1, x.2 + y.2, x.3 ++ y.3⟩ - -variable (α : Type u) [Add α] [Mul α] [Neg α] - -def circEval {n : ℕ} (c : CircuitLines n α α) (id : Fin n) : α := - match (c.circuits id) with - | .const x => x - | .add id₁ id₂ => circEval c ⟨id₁, by grind⟩ + circEval c ⟨id₂, by grind⟩ - | .mul id₁ id₂ => circEval c ⟨id₁, by grind⟩ * circEval c ⟨id₂, by grind⟩ - | .neg id => - circEval c ⟨id, by grind⟩ -termination_by id - - -def depthOf (c : CircuitLines n α α) (id : Fin n) := - match (c.circuits id) with - | .const c => 0 - | .add id₁ id₂ => 1 + max (depthOf c ⟨id₁, by grind⟩) (depthOf c ⟨id₂, by grind⟩) - | .mul id₁ id₂ => 1 + max (depthOf c ⟨id₁, by grind⟩) (depthOf c ⟨id₂, by grind⟩) - | .neg id => 1 + depthOf c ⟨id, by grind⟩ - -def uniqueIDs (q : CircuitLines n α α) (countedIDs : List ℕ) (id : Fin n) : List ℕ := - match (q.circuits id) with - | .const _ => - countedIDs.insert id - | .add id₁ id₂ => - let s₁ := uniqueIDs q countedIDs ⟨id₁, by grind⟩ - let s₂ := uniqueIDs q s₁ ⟨id₂, by clear s₁; grind⟩ - s₂.insert id - | .mul id₁ id₂ => - let s₁ := uniqueIDs q countedIDs ⟨id₁, by grind⟩ - let s₂ := uniqueIDs q s₁ ⟨id₂, by clear s₁; grind⟩ - s₂.insert id - | .neg c => - let s := uniqueIDs q countedIDs ⟨c, by grind⟩ - s.insert id - -def sizeOf (q : CircuitLines n α α) (id : Fin n) := (uniqueIDs α q [] id).length - -def circModel [Add ι] [Mul ι] [Neg ι] : Model (CircuitLines (n + 1) ι) CircuitCosts where - evalQuery {ι} q := @circEval ι q ⟨n, by grind⟩ - cost q := ⟨depthOf q, sizeOf q, uniqueIDs q []⟩ - - -open Circuit in -def exCircuit1 : Prog (Circuit Bool) Bool := do - let x := const 0 true - let y := const 1 true - let z := add 2 x y - let w := mul 3 x y - add 4 z w - -#eval exCircuit1.eval (circModel Bool) -#eval exCircuit1.time (circModel Bool) - -open Circuit in -def exCircuit2 : Prog (Circuit ℚ) ℚ := do - let x := const 0 (1 : ℚ) - let y := const 1 (2 : ℚ) - let z := add 2 x y - mul 4 z z - -#eval exCircuit2.eval (circModel ℚ) -#eval exCircuit2.time (circModel ℚ) - -open Circuit in -def exCircuit3 (x y : Circuit ℚ ℚ) : Prog (Circuit ℚ) ℚ := do - let z := add 2 x y - let w := mul 3 x y - mul 4 z w - -#eval (exCircuit3 (.const 0 (1 : ℚ)) (.const 1 (21 : ℚ))).eval (circModel ℚ) -#eval (exCircuit3 (.const 0 (1 : ℚ)) (.const 1 (21 : ℚ))).time (circModel ℚ) - - -open Circuit in -def CircAnd (n : ℕ) (x : Fin n → Circuit Bool Bool) : Circuit Bool Bool := - match n with - | 0 => const n true - | m + 1 => - let x_head := x 0 - let x_cons := CircAnd m (Fin.tail x) - mul (n + m + 1) x_head x_cons - -def execCircAnd (x : Fin n → Circuit Bool Bool) : Prog (Circuit Bool) Bool := do - CircAnd n x - -#eval (execCircAnd ![.const 0 true, .const 1 true, .const 2 true]).eval (circModel Bool) -#eval (execCircAnd ![.const 0 true, .const 1 true, .const 2 true]).time (circModel Bool) - - - - -end Prog - -end Algorithms - -end Cslib diff --git a/Cslib/Algorithms/CircuitProgs.lean b/Cslib/Algorithms/CircuitProgs.lean deleted file mode 100644 index 6231b9563..000000000 --- a/Cslib/Algorithms/CircuitProgs.lean +++ /dev/null @@ -1,208 +0,0 @@ -/- -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.Algorithms.QueryModel - -@[expose] public section - -namespace Cslib - -namespace Algorithms - -namespace Prog -inductive Formula (α : Type u) : Type u → Type u where - | const (x : α) : Formula α α - | add (c₁ c₂ : Formula α α) : Formula α α - | mul (c₁ c₂ : Formula α α) : Formula α α - | neg (c : Formula α α) : Formula α α -deriving Repr - --- def getID (c : Formula α β) : ℕ := --- match c with --- | .const id _ => id --- | .add id _ _ => id --- | .mul id _ _ => id --- | .neg id _ => id - - -structure CircuitCosts where - depth : ℕ - size : ℕ - -instance : PureCosts CircuitCosts where - pureCost := ⟨0,0⟩ - -instance : Zero CircuitCosts where - zero := ⟨0,0⟩ - -instance : Add CircuitCosts where - add x y := ⟨x.1 + y.1, x.2 + y.2⟩ - -def circEval (α : Type u) [Add α] [Mul α] [Neg α] (c : Formula α ι) : ι := - match c with - | .const x => x - | .add c₁ c₂ => circEval α c₁ + circEval α c₂ - | .mul c₁ c₂ => circEval α c₁ * circEval α c₂ - | .neg c => - circEval α c - - -def depthOf (q : Formula α β) := - match q with - | .const c => 0 - | .add c₁ c₂ => 1 + max (depthOf c₁) (depthOf c₂) - | .mul c₁ c₂ => 1 + max (depthOf c₁) (depthOf c₂) - | .neg c => 1 + depthOf c - --- def uniqueIDs (q : Formula α β) (countedIDs : List ℕ) : List ℕ := --- match q with --- | .const id _ => --- countedIDs.insert id --- | .add id x y => --- let s₁ := uniqueIDs x countedIDs --- let s₂ := uniqueIDs y s₁ --- s₂.insert id --- | .mul id x y => --- let s₁ := uniqueIDs x countedIDs --- let s₂ := uniqueIDs y s₁ --- s₂.insert id --- | .neg id x => --- let s := uniqueIDs x countedIDs --- s.insert id - -def sizeOf (q : Formula α β) := - match q with - | .const c => 1 - | .add c₁ c₂ => 1 + (sizeOf c₁) + (sizeOf c₂) - | .mul c₁ c₂ => 1 + (sizeOf c₁) + (sizeOf c₂) - | .neg c => 1 + sizeOf c - -def circModel (α : Type u) [Add α] [Mul α] [Neg α] : Model (Formula α) CircuitCosts where - evalQuery q := circEval α q - cost q := ⟨depthOf q, sizeOf q⟩ - - -open Formula in -def exFormula1 : Prog (Formula Bool) Bool := do - let x := const true - let y := const true - let z := add x y - let w := mul x y - add z w - - -#eval exFormula1.eval (circModel Bool) -#eval exFormula1.time (circModel Bool) - -open Formula in -def exFormula2 : Prog (Formula ℚ) ℚ := do - let x := const (1 : ℚ) - let y := const (2 : ℚ) - let z := add x y - mul z z - - -#eval exFormula2.eval (circModel ℚ) -#eval exFormula2.time (circModel ℚ) - -open Formula in -def exFormula3 : Prog (Formula ℚ) ℚ := do - let x := const (1 : ℚ) - let y := const (2 : ℚ) - let z := add x y - mul z z - -#eval exFormula2.eval (circModel ℚ) -#eval exFormula2.time (circModel ℚ) - -open Formula in -def exFormula4 (x y : Formula ℚ ℚ) : Prog (Formula ℚ) ℚ := do - let z := add x y - let w := mul x y - mul z w - -#eval (exFormula4 (.const (1 : ℚ)) (.const (21 : ℚ))).eval (circModel ℚ) -#eval (exFormula4 (.const (1 : ℚ)) (.const (21 : ℚ))).time (circModel ℚ) - - -open Formula in -def CircAnd (n : ℕ) (x : Fin n → Formula Bool Bool) : Formula Bool Bool := - match n with - | 0 => const true - | m + 1 => - let x_head := x 0 - let x_cons := CircAnd m (Fin.tail x) - mul x_head x_cons - -def execCircAnd (x : Fin n → Formula Bool Bool) : Prog (Formula Bool) Bool := do - CircAnd n x - -#eval (execCircAnd ![.const true, .const true, .const true]).eval (circModel Bool) -#eval (execCircAnd ![.const true, .const true, .const true]).time (circModel Bool) - - -section Circuit - --- Another query type that reduces to Circuit queries. automates identification of nodes - -inductive Circuit (α : Type u) : Type u → Type u where - | const (x : α) : Circuit α (Formula α α) - | add (c₁ c₂ : Formula α α) : Circuit α (Formula α α) - | mul (c₁ c₂ : Formula α α) : Circuit α (Formula α α) - | neg (c : Formula α α) : Circuit α (Formula α α) - - - -def circQueryEvalAux (α : Type u) - (c : Circuit α ι) : ι := - match c with - | .const x => Formula.const x - | .add c₁ c₂ => Formula.add c₁ c₂ - | .mul c₁ c₂ => Formula.mul c₁ c₂ - | .neg c => Formula.neg c - -def sizeCircQuery (c : Circuit α (Formula α β)) : CircuitCosts := - let c' := circQueryEvalAux α c - ⟨depthOf c', sizeOf c'⟩ - -def circQueryModel (α : Type u) [Add α] [Mul α] [Neg α] : Model (Circuit α) CircuitCosts where - evalQuery q := circQueryEvalAux α q - cost q := match q with - | .const x => sizeCircQuery (.const x) - | .add c₁ c₂ => sizeCircQuery (.add c₁ c₂) - | .mul c₁ c₂ => sizeCircQuery (.mul c₁ c₂) - | .neg c => sizeCircQuery (.neg c) - -open Circuit in -def ex5 : Prog (Circuit ℚ) (Formula ℚ ℚ) := do - let x ← const (1 : ℚ) - let y : Formula ℚ ℚ ← const (2 : ℚ) - let z : Formula ℚ ℚ ← add x y - let w : Formula ℚ ℚ ← mul z z - return w - -#eval ex5.eval (circQueryModel ℚ) -#eval ex5.time (circQueryModel ℚ) - -open Circuit in -def ex6 (a b : Circuit ℚ (Formula ℚ ℚ)) : Prog (Circuit ℚ) (Formula ℚ ℚ) := do - let x : Formula ℚ ℚ ← a - let y : Formula ℚ ℚ ← b - let z : Formula ℚ ℚ ← add x y - mul z z - -def ex6_formula : Formula ℚ ℚ := (ex6 (.const 0) (.const 1)).eval (circQueryModel ℚ) -#eval sizeOf ex6_formula -#eval (ex6 (.const 0) (.const 1)).time (circQueryModel ℚ) - -end Circuit - -end Prog - -end Algorithms - -end Cslib diff --git a/Cslib/Algorithms/MergeSort/MergeSort.lean b/Cslib/Algorithms/MergeSort/MergeSort.lean deleted file mode 100644 index f15a8efda..000000000 --- a/Cslib/Algorithms/MergeSort/MergeSort.lean +++ /dev/null @@ -1,405 +0,0 @@ -/- -Copyright (c) 2025 Tanner Duve. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Tanner Duve --/ - -module - -public import Cslib.Algorithms.QueryModel - -@[expose] public section - -/-! -# Merge sort in the query model - -This file implements merge sort as a program in the query model defined in -`Cslib.Algorithms.QueryModel`. The algorithm uses only comparison queries. - -## Main definitions - -- `merge` : merge step using `Prog` comparisons -- `split` : split a list in two by alternating elements -- `mergeSort` : merge sort expressed in the query model - -We also provide simple example evaluations of `mergeSort` and its time cost. --/ - - - -namespace Cslib.Algorithms - -/-- The Model for comparison sorting natural-number registers. --/ -inductive SortOps (α : Type) : Type → Type where - | cmpLT (x : α) (y : α): SortOps α Bool - | insertHead (l : List α) (x : α) : SortOps α (List α) - -open SortOps - -@[ext] -structure SortOpsCost where - compares : ℕ - inserts : ℕ - pure : ℕ - -@[simp, grind] -instance pcSortOps : PureCosts SortOpsCost where - pureCost := ⟨0,0,1⟩ - -@[simp, grind] -instance zeroSortOps : Zero SortOpsCost := ⟨0,0,0⟩ - -@[simp, grind] -instance addSortOps : Add SortOpsCost where - add | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => ⟨c₁ + c₂, i₁ + i₂, p₁ + p₂⟩ - -@[simp] -instance partialOrderSortOps : PartialOrder SortOpsCost where - le | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ ∧ p₁ ≤ p₂ - le_refl := by - intro c - simp only [le_refl, and_self] - le_trans a b c := by - simp only [and_imp] - intro ab_comps ab_inserts ab_pures bc_comps bc_inserts bc_pures - refine ⟨?_, ?_, ?_⟩ - all_goals solve_by_elim [Nat.le_trans] - le_antisymm := by - intro ⟨a_comps, a_inserts, a_pures⟩ ⟨b_comps, b_inserts, b_pures⟩ - simp only [SortOpsCost.mk.injEq, and_imp] - intro ab_comps ab_inserts ab_pures ba_comps ba_inserts ba_pures - refine ⟨?_, ?_, ?_⟩ - all_goals solve_by_elim[Nat.le_antisymm] - - -@[simp, grind] -def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where - evalQuery q := - match q with - | .cmpLT x y => - if x < y then - true - else - false - | .insertHead l x => x :: l - cost q := - match q with - | .cmpLT _ _ => ⟨1,0,0⟩ - | .insertHead _ _ => ⟨0,1,0⟩ - -lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : - (sortModel α).evalQuery (cmpLT x y) ↔ x < y := by - simp [sortModel] - -lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : - (sortModel α).evalQuery (insertHead l x) = x :: l := by - simp [sortModel] - -lemma SortModel_addComponents [LinearOrder α] (m₁ m₂ m₃ : SortOpsCost) : - m₁ + m₂ = m₃ ↔ - m₁.compares + m₂.compares = m₃.compares ∧ - m₁.inserts + m₂.inserts = m₃.inserts ∧ - m₁.pure + m₂.pure = m₃.pure := by - simp only [HAdd.hAdd, addSortOps] - simp only [instAddNat, Nat.add_eq] - aesop - -lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : - m₁ ≤ m₂ ↔ - m₁.compares ≤ m₂.compares ∧ - m₁.inserts ≤ m₂.inserts ∧ - m₁.pure ≤ m₂.pure := by - simp only [LE.le] - -def insertOrd' (l : List α) [LinearOrder α] (x : α) := - match l with - | [] => [x] - | a :: as => if a < x then insertOrd' as x else x :: (a :: as) - - -def insertOrd (l : List α) (x : α) : Prog (SortOps α) (List α) := do - match l with - | [] => insertHead l x - | a :: as => - let cmp : Bool ← cmpLT a x - if cmp - then - insertOrd as x - else - insertHead (a :: as) x - -lemma insertOrd_is_insertOrd' [LinearOrder α] : - ∀ (l : List α) (x : α), - (insertOrd l x).eval (sortModel α) = insertOrd' l x := by - intro l x - induction l with - | nil => - simp_all [insertOrd, insertOrd', Id.run] - | cons head tail ih => - simp_all only [Prog.eval, Id.run, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, - Bool.if_false_right, Bool.and_true, insertOrd, bind, FreeM.lift_def, FreeM.liftBind_bind, - FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq, insertOrd'] - split_ifs with h_head - · exact ih - · simp - - -lemma insertOrd_complexity [LinearOrder α] : - ∀ (l : List α) (x : α), - (insertOrd l x).time (sortModel α) ≤ ⟨l.length, 1, 1⟩ := by - intro l x - induction l with - | nil => - simp_all [sortModel, insertOrd, Prog.time, PureCosts.pureCost, HAdd.hAdd, addSortOps] - | cons head tail ih => - simp only [insertOrd, bind, FreeM.lift_def, FreeM.liftBind_bind, FreeM.pure_bind, Prog.time, - List.length_cons] - by_cases h_head : head < x - · split_ifs - all_goals - simp only at ih - have h₁ : (⟨tail.length + 1, 1, 1⟩ : SortOpsCost) = ⟨1,0,0⟩ + ⟨tail.length, 1, 1⟩ := by - simp only [HAdd.hAdd, addSortOps, SortOpsCost.mk.injEq, and_self, and_true] - simp only [instAddNat, Nat.add_eq, Nat.add_comm] - rw [h₁] - rw [SortModel_leComponents] at * - refine ⟨?_, ?_, ?_⟩ - all_goals - clear h₁ - apply Nat.add_le_add - · simp - · --replace ih := ih.1 - simp [-sortModel] at ih - grind - · simp only [sortModel, Bool.if_false_right, Bool.and_true, decide_eq_true_eq] - split_ifs - · simp only [partialOrderSortOps, not_and, not_le, addSortOps, Prog.time, - PureCosts.pureCost] - refine ⟨?_, ?_, ?_⟩ - · simp only [HAdd.hAdd] - simp only [instAddNat, Nat.add_eq, add_zero, le_add_iff_nonneg_left, zero_le] - · simp only [HAdd.hAdd] - simp only [instAddNat, Nat.add_eq, add_zero, zero_add, le_refl] - · simp only [HAdd.hAdd, le_refl] - - -lemma List_Monotone_tail [LinearOrder α] (l : List α) (x : α) : - Monotone (x :: l).get → Monotone l.get := by - intro h - simp_all only [Monotone, List.length_cons, List.get_eq_getElem] - intro i j hij - have : i.castSucc + 1 ≤ j.castSucc + 1 := by - simp only [Fin.coeSucc_eq_succ, Fin.succ_le_succ_iff] - exact hij - specialize @h (i.castSucc + 1) (j.castSucc + 1) this - simp_all only [Fin.coeSucc_eq_succ, Fin.val_succ, List.getElem_cons_succ] - -lemma List.cons_get_pred_get (l : List α) (x : α) - (i : Fin (x :: l).length) (hi : i > ⟨0, by grind⟩) : - (x :: l).get i = l.get (i.pred (by aesop)) := by - grind - -lemma List_Monotone_of_cons [LinearOrder α] (tail : List α) (head : α) : - Monotone (head :: tail).get ↔ Monotone tail.get ∧ ∀ y ∈ tail, head ≤ y := by - constructor - · intro mono - constructor - · apply List_Monotone_tail at mono - assumption - · intro y y_tail - obtain ⟨i,hi⟩ := List.get_of_mem y_tail - simp only [Monotone, List.length_cons, List.get_eq_getElem] at mono - specialize @mono 0 (i.castSucc + 1) (by simp) - simp_all - · intro ⟨htail_mono, h_head⟩ i j hij - by_cases hi_eq_j : i = j - · rw [hi_eq_j] - · apply Std.lt_of_le_of_ne at hij - apply hij at hi_eq_j - have s₁ : ⟨0, by grind⟩ < j := by - grind - have s₂ : (head :: tail).get j ∈ tail := by - grind - by_cases hi_zero : i = ⟨0, by grind⟩ - · rw [hi_zero] - simp only [List.length_cons, Fin.zero_eta, List.get_eq_getElem, Fin.coe_ofNat_eq_mod, - Nat.zero_mod, List.getElem_cons_zero, ge_iff_le] - specialize h_head (head :: tail)[↑j] s₂ - exact h_head - · have s₃ : i > ⟨0, by grind⟩ := by - grind - rw [List.cons_get_pred_get, List.cons_get_pred_get] - · apply htail_mono - grind - · exact s₁ - · exact s₃ - - - - - -lemma List_Monotone_cons [LinearOrder α] (tail : List α) (x head : α) - (hx : x ≤ head) (h_mono : Monotone (head :: tail).get) : Monotone (x :: head :: tail).get := by - have s₁ : ∀ y ∈ tail, head ≤ y := by - intro x x_in_tail - simp_all [Monotone] - obtain ⟨i, hi⟩ := List.get_of_mem x_in_tail - specialize @h_mono 0 (i.castSucc + 1) (by simp) - simp at h_mono - simp_all - rw [List_Monotone_of_cons] - simp only [List.length_cons, List.mem_cons, forall_eq_or_imp] - constructor - · exact h_mono - · constructor - · grind - · intro y y_in_tail - specialize s₁ y y_in_tail - grind - - -lemma insertOrd'_sorted [LinearOrder α] (l : List α) (x : α) : - Monotone l.get → Monotone (insertOrd' l x).get := by - intro l_mono - induction l with - | nil => - simp_all [Monotone] - | cons head tail ih => - have ltail_mono := List_Monotone_tail tail head l_mono - specialize ih ltail_mono - simp only [insertOrd'] - split_ifs with h_head - · grind - · apply List_Monotone_cons at l_mono - case x => exact x - all_goals grind - - -lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : - Monotone l.get → Monotone ((insertOrd l x).eval (sortModel α)).get := by - intro l_mono - rw [insertOrd_is_insertOrd' l x] - induction l with - | nil => - simp[Monotone] - | cons head tail ih => - specialize ih (List_Monotone_tail tail head l_mono) - simp only [insertOrd'] - split_ifs with h_head - · grind - · intro i j hij - simp only [h_head, List.get_eq_getElem, ↓reduceIte] - apply List_Monotone_cons - · grind - · exact l_mono - · grind - - - -/-- Merge two sorted lists using comparisons in the query monad. -/ -def mergeNaive [LinearOrder α] (x y : List α) : List α := - match x,y with - | [], ys => ys - | xs, [] => xs - | x :: xs', y :: ys' => - if x < y then - let rest := mergeNaive xs' (y :: ys') - x :: rest - else - let rest := mergeNaive (x :: xs') ys' - y :: rest - -/-- Merge two sorted lists using comparisons in the query monad. -/ -@[simp, grind] -def merge (x y : List α) : Prog (SortOps α) (List α) := do - match x,y with - | [], ys => return ys - | xs, [] => return xs - | x :: xs', y :: ys' => do - let cmp : Bool ← cmpLT 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_is_mergeNaive [LinearOrder α] (x y : List α) : - (merge x y).eval (sortModel α) = mergeNaive x y := by - fun_induction mergeNaive - · simp [merge, Id.run] - · expose_names - simp [Id.run] - · expose_names - simp only [Prog.eval, Id.run, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, - Bool.if_false_right, Bool.and_true, merge, bind, FreeM.lift_def, FreeM.liftBind_bind, - FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq] - simp_all only [Prog.eval, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, - Bool.if_false_right, Bool.and_true, ↓reduceIte, FreeM.liftM_bind, bind, - FreeM.liftM_pure, List.cons.injEq, true_and, rest] - exact ih1 - · simp only [Prog.eval, Id.run, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, - Bool.if_false_right, Bool.and_true, merge, bind, FreeM.lift_def, FreeM.liftBind_bind, - FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq] - rename_i rest ih1 - simp_all only [not_lt, Prog.eval, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, - Bool.if_false_right, Bool.and_true, rest] - split - next h_1 => - simp_all only [FreeM.liftM_bind, bind, FreeM.liftM_pure, pure, List.cons.injEq] - apply And.intro - · grind - · grind - next - h_1 => - simp_all only [not_lt, FreeM.liftM_bind, bind, FreeM.liftM_pure, pure, List.cons.injEq, - true_and] - exact ih1 - -lemma mergeNaive_sorted_sorted [LinearOrder α] (xs ys : List α) - (hxs_mono : Monotone xs.get) (hys_mono : Monotone ys.get) : - Monotone (mergeNaive xs ys).get := by - fun_induction mergeNaive - · simp_all - · simp_all - · rename_i rest ih1 - expose_names - simp_all only [List.length_cons, forall_const, rest] - specialize ih1 (List_Monotone_tail xs' x hxs_mono) - - sorry - · rename_i rest ih1 - expose_names - simp_all only [not_lt, List.length_cons, forall_const, rest] - specialize ih1 (List_Monotone_tail ys' y hys_mono) - - sorry - -/-- Split a list into two lists by alternating elements. -/ -def split (xs : List Nat) : List Nat × List Nat := - let rec go : List Nat → List Nat → List Nat → List Nat × List Nat - | [], accL, accR => (accL.reverse, accR.reverse) - | [x], accL, accR => ((x :: accL).reverse, accR.reverse) - | x :: y :: xs, accL, accR => go xs (x :: accL) (y :: accR) - go xs [] [] - -/-- Merge sort expressed as a program in the query model. -TODO: Working version without partial -/ -partial def mergeSort : List Nat → Prog (SortOps Nat) (List Nat) - | [] => pure [] - | [x] => pure [x] - | xs => - let (left, right) := split xs - do - let sortedLeft ← mergeSort left - let sortedRight ← mergeSort right - merge sortedLeft sortedRight - -#eval (mergeSort [5,3,8,6,2,7,4,1]).eval (sortModel Nat) -#eval (mergeSort [5,3,8,6,2,7,4,1]).time (sortModel Nat) - - - - -end Cslib.Algorithms diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean new file mode 100644 index 000000000..e69de29bb diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean new file mode 100644 index 000000000..39ab7af0d --- /dev/null +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -0,0 +1,120 @@ +/- +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 + + +namespace Cslib + +namespace Algorithms + +open Prog + +inductive ListSearch (α : Type) : Type → Type where + | compare (a : List α) (val : α) : ListSearch α Bool + + +def ListSearch_Nat [DecidableEq α] : Model (ListSearch α) ℕ where + evalQuery q := + match q with + | .compare l x => l.head? = some x + cost q := + match q with + | .compare _ _ => 1 + +structure CmpCount where + cmp : ℕ + pure : ℕ + +instance : Add (CmpCount) where + add x y := ⟨x.1 + y.1, x.2 + y.2⟩ + +instance : Zero (CmpCount) where + zero := ⟨0,0⟩ + +instance : PureCosts (CmpCount) where + pureCost := ⟨0,1⟩ + +def ListSearch_Cmp [DecidableEq α] : Model (ListSearch α) CmpCount where + evalQuery q := + match q with + | .compare l x => l.head? == some x + cost q := + match q with + | .compare _ _ => ⟨1,0⟩ + +open ListSearch in +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 + +lemma listLinearSearchM_correct_true [iDec : DecidableEq α] (l : List α) : + ∀ x : α, x ∈ l → (listLinearSearch l x).eval ListSearch_Nat = true := by + intro x x_mem_l + induction l with + | nil => + simp_all only [List.not_mem_nil] + | cons head tail ih => + simp_all only [List.mem_cons, listLinearSearch, bind, FreeM.lift_def, pure, + FreeM.liftBind_bind, FreeM.pure_bind, eval, FreeM.liftM, Id.run] + split_ifs with h + · simp + · obtain (x_head | xtail) := x_mem_l + · rw [x_head] at h + simp[ListSearch_Nat] at h + · specialize ih xtail + exact ih + +lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) : + ∀ x : α, x ∉ l → (listLinearSearch l x).eval ListSearch_Nat = false := by + intro x x_mem_l + induction l with + | nil => + simp_all [listLinearSearch, eval, Id.run] + | cons head tail ih => + simp only [List.mem_cons, not_or] at x_mem_l + specialize ih x_mem_l.2 + simp only [listLinearSearch, bind, FreeM.lift_def, pure, FreeM.liftBind_bind, FreeM.pure_bind, + eval, FreeM.liftM, Id.run] + split_ifs with h_eq + · simp [ListSearch_Nat] at h_eq + exfalso + exact x_mem_l.1 h_eq.symm + · exact ih + + + +lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List α) : + ∀ x : α, (listLinearSearch l x).time ListSearch_Nat ≤ 1 + l.length := by + intro x + induction l with + | nil => + simp_all [listLinearSearch, ListSearch_Nat, time, PureCosts.pureCost] + | cons head tail ih => + simp_all [listLinearSearch, ListSearch_Nat, time] + split_ifs with h_head + · simp [time, PureCosts.pureCost] + · grind + +lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Nontrivial α] : + ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = 1 + l.length := by + obtain ⟨x, y, x_neq_y⟩ := inon + use [x,x,x,x,x,y], y + simp_all [time, ListSearch_Nat, listLinearSearch, PureCosts.pureCost] + +end Algorithms +end Cslib diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean new file mode 100644 index 000000000..e6fd44148 --- /dev/null +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -0,0 +1,212 @@ +/- +Copyright (c) 2026 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.UpstreamLemmas +public import Mathlib + +@[expose] public section + + +namespace Cslib + +namespace Algorithms + +open Prog +/-- The Model for comparison sorting natural-number registers. +-/ +inductive SortOps (α : Type) : Type → Type where + | cmpLT (x : α) (y : α): SortOps α Bool + | insertHead (l : List α) (x : α) : SortOps α (List α) + +open SortOps + +@[ext] +structure SortOpsCost where + compares : ℕ + inserts : ℕ + pure : ℕ + +@[simp, grind] +instance pcSortOps : PureCosts SortOpsCost where + pureCost := ⟨0,0,1⟩ + +@[simp, grind] +instance zeroSortOps : Zero SortOpsCost := ⟨0,0,0⟩ + +@[simp, grind] +instance addSortOps : Add SortOpsCost where + add | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => ⟨c₁ + c₂, i₁ + i₂, p₁ + p₂⟩ + +@[simp] +instance partialOrderSortOps : PartialOrder SortOpsCost where + le | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ ∧ p₁ ≤ p₂ + le_refl := by + intro c + simp only [le_refl, and_self] + le_trans a b c := by + simp only [and_imp] + intro ab_comps ab_inserts ab_pures bc_comps bc_inserts bc_pures + refine ⟨?_, ?_, ?_⟩ + all_goals solve_by_elim [Nat.le_trans] + le_antisymm := by + intro ⟨a_comps, a_inserts, a_pures⟩ ⟨b_comps, b_inserts, b_pures⟩ + simp only [SortOpsCost.mk.injEq, and_imp] + intro ab_comps ab_inserts ab_pures ba_comps ba_inserts ba_pures + refine ⟨?_, ?_, ?_⟩ + all_goals solve_by_elim[Nat.le_antisymm] + + +@[simp, grind] +def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where + evalQuery q := + match q with + | .cmpLT x y => + if x < y then + true + else + false + | .insertHead l x => x :: l + cost q := + match q with + | .cmpLT _ _ => ⟨1,0,0⟩ + | .insertHead _ _ => ⟨0,1,0⟩ + +lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : + (sortModel α).evalQuery (cmpLT x y) ↔ x < y := by + simp [sortModel] + +lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : + (sortModel α).evalQuery (insertHead l x) = x :: l := by + simp [sortModel] + +lemma SortModel_addComponents [LinearOrder α] (m₁ m₂ m₃ : SortOpsCost) : + m₁ + m₂ = m₃ ↔ + m₁.compares + m₂.compares = m₃.compares ∧ + m₁.inserts + m₂.inserts = m₃.inserts ∧ + m₁.pure + m₂.pure = m₃.pure := by + simp only [HAdd.hAdd, addSortOps] + simp only [instAddNat, Nat.add_eq] + aesop + +lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : + m₁ ≤ m₂ ↔ + m₁.compares ≤ m₂.compares ∧ + m₁.inserts ≤ m₂.inserts ∧ + m₁.pure ≤ m₂.pure := by + simp only [LE.le] + +def insertOrdNaive (l : List α) [LinearOrder α] (x : α) := + match l with + | [] => [x] + | a :: as => if a < x then insertOrdNaive as x else x :: (a :: as) + + +lemma insertOrdNaive_sorted [LinearOrder α] (l : List α) (x : α) : + Monotone l.get → Monotone (insertOrdNaive l x).get := by + intro l_mono + induction l with + | nil => + simp_all [Monotone] + | cons head tail ih => + have ltail_mono := List_Monotone_tail tail head l_mono + specialize ih ltail_mono + simp only [insertOrdNaive] + split_ifs with h_head + · grind + · apply List_Monotone_cons at l_mono + case x => exact x + all_goals grind + + +def insertOrd (l : List α) (x : α) : Prog (SortOps α) (List α) := do + match l with + | [] => insertHead l x + | a :: as => + let cmp : Bool ← cmpLT a x + if cmp + then + insertOrd as x + else + insertHead (a :: as) x + +lemma insertOrd_is_insertOrdNaive [LinearOrder α] : + ∀ (l : List α) (x : α), + (insertOrd l x).eval (sortModel α) = insertOrdNaive l x := by + intro l x + induction l with + | nil => + simp_all [insertOrd, insertOrdNaive, Id.run] + | cons head tail ih => + simp_all only [Prog.eval, Id.run, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + Bool.if_false_right, Bool.and_true, insertOrd, bind, FreeM.lift_def, FreeM.liftBind_bind, + FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq, insertOrdNaive] + split_ifs with h_head + · exact ih + · simp + + +lemma insertOrd_complexity_upper_bound [LinearOrder α] : + ∀ (l : List α) (x : α), + (insertOrd l x).time (sortModel α) ≤ ⟨l.length, 1, 1⟩ := by + intro l x + induction l with + | nil => + simp_all [sortModel, insertOrd, Prog.time, PureCosts.pureCost, HAdd.hAdd, addSortOps] + | cons head tail ih => + simp only [insertOrd, bind, FreeM.lift_def, FreeM.liftBind_bind, FreeM.pure_bind, Prog.time, + List.length_cons] + by_cases h_head : head < x + · split_ifs + all_goals + simp only at ih + have h₁ : (⟨tail.length + 1, 1, 1⟩ : SortOpsCost) = ⟨1,0,0⟩ + ⟨tail.length, 1, 1⟩ := by + simp only [HAdd.hAdd, addSortOps, SortOpsCost.mk.injEq, and_self, and_true] + simp only [instAddNat, Nat.add_eq, Nat.add_comm] + rw [h₁] + rw [SortModel_leComponents] at * + refine ⟨?_, ?_, ?_⟩ + all_goals + clear h₁ + apply Nat.add_le_add + · simp + · --replace ih := ih.1 + simp [-sortModel] at ih + grind + · simp only [sortModel, Bool.if_false_right, Bool.and_true, decide_eq_true_eq] + split_ifs + · simp only [partialOrderSortOps, not_and, not_le, addSortOps, Prog.time, + PureCosts.pureCost] + refine ⟨?_, ?_, ?_⟩ + · simp only [HAdd.hAdd] + simp only [instAddNat, Nat.add_eq, add_zero, le_add_iff_nonneg_left, zero_le] + · simp only [HAdd.hAdd] + simp only [instAddNat, Nat.add_eq, add_zero, zero_add, le_refl] + · simp only [HAdd.hAdd, le_refl] + +lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : + Monotone l.get → Monotone ((insertOrd l x).eval (sortModel α)).get := by + intro l_mono + rw [insertOrd_is_insertOrdNaive l x] + induction l with + | nil => + simp[Monotone] + | cons head tail ih => + specialize ih (List_Monotone_tail tail head l_mono) + simp only [insertOrdNaive] + split_ifs with h_head + · grind + · intro i j hij + simp only [h_head, List.get_eq_getElem, ↓reduceIte] + apply List_Monotone_cons + · grind + · exact l_mono + · grind +end Algorithms + +end Cslib diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean new file mode 100644 index 000000000..e6115ce2b --- /dev/null +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -0,0 +1,269 @@ +/- +Copyright (c) 2025 Tanner Duve. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tanner Duve +-/ + +module + +public import Cslib.AlgorithmsTheory.QueryModel + +@[expose] public section + +/-! +# Merge sort in the query model + +This file implements merge sort as a program in the query model defined in +`Cslib.Algorithms.QueryModel`. We use a two model approach to demonstrate the +wonders of reducing between models. + +## Main definitions + +- `merge` : merge step using `Prog` comparisons +- `split` : split a list in two by alternating elements +- `mergeSort` : merge sort expressed in the query model + +We also provide simple example evaluations of `mergeSort` and its time cost. +-/ + + + +namespace Cslib.Algorithms + + +inductive SortOps (α : Type) : Type → Type where + | cmpLT (x : α) (y : α): SortOps α Bool + | insertHead (l : List α) (x : α) : SortOps α (List α) + +open SortOps + +@[ext] +structure SortOpsCost where + compares : ℕ + inserts : ℕ + pure : ℕ + +@[simp, grind] +instance pcSortOps : PureCosts SortOpsCost where + pureCost := ⟨0,0,1⟩ + +@[simp, grind] +instance zeroSortOps : Zero SortOpsCost := ⟨0,0,0⟩ + +@[simp, grind] +instance addSortOps : Add SortOpsCost where + add | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => ⟨c₁ + c₂, i₁ + i₂, p₁ + p₂⟩ + +@[simp] +instance partialOrderSortOps : PartialOrder SortOpsCost where + le | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ ∧ p₁ ≤ p₂ + le_refl := by + intro c + simp only [le_refl, and_self] + le_trans a b c := by + simp only [and_imp] + intro ab_comps ab_inserts ab_pures bc_comps bc_inserts bc_pures + refine ⟨?_, ?_, ?_⟩ + all_goals solve_by_elim [Nat.le_trans] + le_antisymm := by + intro ⟨a_comps, a_inserts, a_pures⟩ ⟨b_comps, b_inserts, b_pures⟩ + simp only [SortOpsCost.mk.injEq, and_imp] + intro ab_comps ab_inserts ab_pures ba_comps ba_inserts ba_pures + refine ⟨?_, ?_, ?_⟩ + all_goals solve_by_elim[Nat.le_antisymm] + + +@[simp, grind] +def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where + evalQuery q := + match q with + | .cmpLT x y => + if x < y then + true + else + false + | .insertHead l x => x :: l + cost q := + match q with + | .cmpLT _ _ => ⟨1,0,0⟩ + | .insertHead _ _ => ⟨0,1,0⟩ + +lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : + (sortModel α).evalQuery (cmpLT x y) ↔ x < y := by + simp [sortModel] + +lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : + (sortModel α).evalQuery (insertHead l x) = x :: l := by + simp [sortModel] + +lemma SortModel_addComponents [LinearOrder α] (m₁ m₂ m₃ : SortOpsCost) : + m₁ + m₂ = m₃ ↔ + m₁.compares + m₂.compares = m₃.compares ∧ + m₁.inserts + m₂.inserts = m₃.inserts ∧ + m₁.pure + m₂.pure = m₃.pure := by + simp only [HAdd.hAdd, addSortOps] + simp only [instAddNat, Nat.add_eq] + aesop + +lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : + m₁ ≤ m₂ ↔ + m₁.compares ≤ m₂.compares ∧ + m₁.inserts ≤ m₂.inserts ∧ + m₁.pure ≤ m₂.pure := by + simp only [LE.le] + +def insertOrdNaive (l : List α) [LinearOrder α] (x : α) := + match l with + | [] => [x] + | a :: as => if a < x then insertOrdNaive as x else x :: (a :: as) + + + + + + + + +/-- Merge two sorted lists using comparisons in the query monad. -/ +def mergeNaive [LinearOrder α] (x y : List α) : List α := + match x,y with + | [], ys => ys + | xs, [] => xs + | x :: xs', y :: ys' => + if x < y then + let rest := mergeNaive xs' (y :: ys') + x :: rest + else + let rest := mergeNaive (x :: xs') ys' + y :: rest + +/-- Merge two sorted lists using comparisons in the query monad. -/ +@[simp, grind] +def merge (x y : List α) : Prog (SortOps α) (List α) := do + match x,y with + | [], ys => return ys + | xs, [] => return xs + | x :: xs', y :: ys' => do + let cmp : Bool ← cmpLT 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 [LinearOrder α] (x y : List α) : + (merge x y).time (sortModel α) = ⟨min x.length y.length , 0 ,1⟩ := by + fun_induction merge + · simp + · simp + · expose_names + simp + split_ifs with hxy + · + done + · done + + +lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : + (merge x y).eval (sortModel α) = mergeNaive x y := by + fun_induction mergeNaive + · simp [merge, Id.run] + · expose_names + simp [Id.run] + · expose_names + simp only [Prog.eval, Id.run, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + Bool.if_false_right, Bool.and_true, merge, bind, FreeM.lift_def, FreeM.liftBind_bind, + FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq] + simp_all only [Prog.eval, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + Bool.if_false_right, Bool.and_true, ↓reduceIte, FreeM.liftM_bind, bind, + FreeM.liftM_pure, List.cons.injEq, true_and, rest] + exact ih1 + · simp only [Prog.eval, Id.run, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + Bool.if_false_right, Bool.and_true, merge, bind, FreeM.lift_def, FreeM.liftBind_bind, + FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq] + rename_i rest ih1 + simp_all only [not_lt, Prog.eval, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + Bool.if_false_right, Bool.and_true, rest] + split + next h_1 => + simp_all only [FreeM.liftM_bind, bind, FreeM.liftM_pure, pure, List.cons.injEq] + apply And.intro + · grind + · grind + next + h_1 => + simp_all only [not_lt, FreeM.liftM_bind, bind, FreeM.liftM_pure, pure, List.cons.injEq, + true_and] + exact ih1 + + + + +/-- Split a list into two lists by alternating elements. -/ +def split (xs : List Nat) : List Nat × List Nat := + let rec go : List Nat → List Nat → List Nat → List Nat × List Nat + | [], accL, accR => (accL.reverse, accR.reverse) + | [x], accL, accR => ((x :: accL).reverse, accR.reverse) + | x :: y :: xs, accL, accR => go xs (x :: accL) (y :: accR) + go xs [] [] + +-- /-- Merge sort expressed as a program in the query model. +-- TODO: Working version without partial -/ +-- partial def mergeSort : List Nat → Prog (SortOps Nat) (List Nat) +-- | [] => pure [] +-- | [x] => pure [x] +-- | xs => +-- let (left, right) := split xs +-- do +-- let sortedLeft ← mergeSort left +-- let sortedRight ← mergeSort right +-- merge sortedLeft sortedRight + +-- #eval (mergeSort [5,3,8,6,2,7,4,1]).eval (sortModel Nat) +-- #eval (mergeSort [5,3,8,6,2,7,4,1]).time (sortModel Nat) + +def mergeSort (xs : List α) : Prog (SortOps α) (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 + +def mergeSortNaive [LinearOrder α] (xs : List α) : List α := + if xs.length < 2 then xs + else + let sortedLeft := mergeSortNaive (xs.take (xs.length/2)) + let sortedRight := mergeSortNaive (xs.drop (xs.length/2)) + mergeNaive sortedLeft sortedRight + +lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : + (mergeSort xs).eval (sortModel α) = mergeSortNaive xs := by + unfold mergeSortNaive + induction xs.length using Nat.strong_induction_on with + | h n ih => + unfold mergeSort + split_ifs with hxs_len + · simp [Id.run] + · simp [Id.run] + specialize ih (n / 2) (by grind) + split_ifs at ih with h_ih_if + · rw [←ih] + unfold mergeSort + simp_rw [←merge_is_mergeNaive] + done + · done + · simp [Id.run] + done + · done + + +lemma mergeNaive_sorted_sorted [LinearOrder α] (xs ys : List α) + (hxs_mono : Monotone xs.get) (hys_mono : Monotone ys.get) : + Monotone (mergeNaive xs ys).get := by + sorry + +end Cslib.Algorithms diff --git a/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean b/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean similarity index 100% rename from Cslib/Algorithms/Lean/MergeSort/MergeSort.lean rename to Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean 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/Algorithms/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean similarity index 100% rename from Cslib/Algorithms/QueryModel.lean rename to Cslib/AlgorithmsTheory/QueryModel.lean diff --git a/Cslib/AlgorithmsTheory/StandardModels/ParametricWordRAM.lean b/Cslib/AlgorithmsTheory/StandardModels/ParametricWordRAM.lean new file mode 100644 index 000000000..e69de29bb diff --git a/Cslib/AlgorithmsTheory/UpstreamLemmas.lean b/Cslib/AlgorithmsTheory/UpstreamLemmas.lean new file mode 100644 index 000000000..dea9cd2a8 --- /dev/null +++ b/Cslib/AlgorithmsTheory/UpstreamLemmas.lean @@ -0,0 +1,90 @@ +/- +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 + +namespace Cslib + +namespace Algorithms + +lemma List_Monotone_tail [LinearOrder α] (l : List α) (x : α) : + Monotone (x :: l).get → Monotone l.get := by + intro h + simp_all only [Monotone, List.length_cons, List.get_eq_getElem] + intro i j hij + have : i.castSucc + 1 ≤ j.castSucc + 1 := by + simp only [Fin.coeSucc_eq_succ, Fin.succ_le_succ_iff] + exact hij + specialize @h (i.castSucc + 1) (j.castSucc + 1) this + simp_all only [Fin.coeSucc_eq_succ, Fin.val_succ, List.getElem_cons_succ] + +lemma List.cons_get_pred_get (l : List α) (x : α) + (i : Fin (x :: l).length) (hi : i > ⟨0, by grind⟩) : + (x :: l).get i = l.get (i.pred (by aesop)) := by + grind + +lemma List_Monotone_of_cons [LinearOrder α] (tail : List α) (head : α) : + Monotone (head :: tail).get ↔ Monotone tail.get ∧ ∀ y ∈ tail, head ≤ y := by + constructor + · intro mono + constructor + · apply List_Monotone_tail at mono + assumption + · intro y y_tail + obtain ⟨i,hi⟩ := List.get_of_mem y_tail + simp only [Monotone, List.length_cons, List.get_eq_getElem] at mono + specialize @mono 0 (i.castSucc + 1) (by simp) + simp_all + · intro ⟨htail_mono, h_head⟩ i j hij + by_cases hi_eq_j : i = j + · rw [hi_eq_j] + · apply Std.lt_of_le_of_ne at hij + apply hij at hi_eq_j + have s₁ : ⟨0, by grind⟩ < j := by + grind + have s₂ : (head :: tail).get j ∈ tail := by + grind + by_cases hi_zero : i = ⟨0, by grind⟩ + · rw [hi_zero] + simp only [List.length_cons, Fin.zero_eta, List.get_eq_getElem, Fin.coe_ofNat_eq_mod, + Nat.zero_mod, List.getElem_cons_zero, ge_iff_le] + specialize h_head (head :: tail)[↑j] s₂ + exact h_head + · have s₃ : i > ⟨0, by grind⟩ := by + grind + rw [List.cons_get_pred_get, List.cons_get_pred_get] + · apply htail_mono + grind + · exact s₁ + · exact s₃ + +lemma List_Monotone_cons [LinearOrder α] (tail : List α) (x head : α) + (hx : x ≤ head) (h_mono : Monotone (head :: tail).get) : Monotone (x :: head :: tail).get := by + have s₁ : ∀ y ∈ tail, head ≤ y := by + intro x x_in_tail + simp_all [Monotone] + obtain ⟨i, hi⟩ := List.get_of_mem x_in_tail + specialize @h_mono 0 (i.castSucc + 1) (by simp) + simp at h_mono + simp_all + rw [List_Monotone_of_cons] + simp only [List.length_cons, List.mem_cons, forall_eq_or_imp] + constructor + · exact h_mono + · constructor + · grind + · intro y y_in_tail + specialize s₁ y y_in_tail + grind + +end Algorithms + +end Cslib diff --git a/Cslib/Algorithms/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean similarity index 99% rename from Cslib/Algorithms/ProgExamples.lean rename to CslibTests/QueryModel/ProgExamples.lean index 80556828f..20861d017 100644 --- a/Cslib/Algorithms/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -6,7 +6,7 @@ Authors: Shreyas Srinivas module -public import Cslib.Algorithms.QueryModel +public import Cslib.AlgorithmsTheory.QueryModel @[expose] public section diff --git a/Cslib/Algorithms/QueryExamples.lean b/CslibTests/QueryModel/QueryExamples.lean similarity index 97% rename from Cslib/Algorithms/QueryExamples.lean rename to CslibTests/QueryModel/QueryExamples.lean index b40bcdbe5..5360c130f 100644 --- a/Cslib/Algorithms/QueryExamples.lean +++ b/CslibTests/QueryModel/QueryExamples.lean @@ -6,7 +6,7 @@ Authors: Shreyas Srinivas module -public import Cslib.Algorithms.QueryModel +public import Cslib.AlgorithmsTheory.QueryModel @[expose] public section From e99f82c886ea908bd4bea1eb7c649251fc147a15 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 17 Feb 2026 00:52:08 +0100 Subject: [PATCH 058/176] Fix stuff --- .../Algorithms/ListInsertionSort.lean | 34 +++ .../Algorithms/ListOrderedInsert.lean | 280 +++++++++--------- .../Algorithms/MergeSort.lean | 107 ++----- Cslib/AlgorithmsTheory/QueryModel.lean | 15 + Cslib/AlgorithmsTheory/UpstreamLemmas.lean | 90 ------ 5 files changed, 213 insertions(+), 313 deletions(-) delete mode 100644 Cslib/AlgorithmsTheory/UpstreamLemmas.lean diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index e69de29bb..cb7661ddf 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 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.Algorithms.ListOrderedInsert +public import Mathlib + +@[expose] public section + +namespace Cslib + +namespace Algorithms + +open Prog + +#check insertOrd +#check List.foldr + +def insertionSort (l : List α) : Prog (SortOps α) (List α) := + match l with + | [] => return [] + | x :: xs => do + let rest ← insertionSort xs + insertOrd x rest + + + +end Algorithms + +end Cslib diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index e6fd44148..b9fd0295a 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -7,7 +7,6 @@ Authors: Shreyas Srinivas module public import Cslib.AlgorithmsTheory.QueryModel -public import Cslib.AlgorithmsTheory.UpstreamLemmas public import Mathlib @[expose] public section @@ -26,44 +25,83 @@ inductive SortOps (α : Type) : Type → Type where open SortOps -@[ext] -structure SortOpsCost where - compares : ℕ - inserts : ℕ - pure : ℕ +-- @[ext] +-- structure SortOpsCost where +-- compares : ℕ +-- inserts : ℕ +-- pure : ℕ + +-- @[simp, grind] +-- instance pcSortOps : PureCosts SortOpsCost where +-- pureCost := ⟨0,0,1⟩ + +-- @[simp, grind] +-- instance zeroSortOps : Zero SortOpsCost := ⟨0,0,0⟩ + +-- @[simp, grind] +-- instance addSortOps : Add SortOpsCost where +-- add | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => ⟨c₁ + c₂, i₁ + i₂, p₁ + p₂⟩ + +-- @[simp] +-- instance partialOrderSortOps : PartialOrder SortOpsCost where +-- le | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ ∧ p₁ ≤ p₂ +-- le_refl := by +-- intro c +-- simp only [le_refl, and_self] +-- le_trans a b c := by +-- simp only [and_imp] +-- intro ab_comps ab_inserts ab_pures bc_comps bc_inserts bc_pures +-- refine ⟨?_, ?_, ?_⟩ +-- all_goals solve_by_elim [Nat.le_trans] +-- le_antisymm := by +-- intro ⟨a_comps, a_inserts, a_pures⟩ ⟨b_comps, b_inserts, b_pures⟩ +-- simp only [SortOpsCost.mk.injEq, and_imp] +-- intro ab_comps ab_inserts ab_pures ba_comps ba_inserts ba_pures +-- refine ⟨?_, ?_, ?_⟩ +-- all_goals solve_by_elim[Nat.le_antisymm] + + +-- @[simp, grind] +-- def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where +-- evalQuery q := +-- match q with +-- | .cmpLT x y => +-- if x < y then +-- true +-- else +-- false +-- | .insertHead l x => x :: l +-- cost q := +-- match q with +-- | .cmpLT _ _ => ⟨1,0,0⟩ +-- | .insertHead _ _ => ⟨0,1,0⟩ + +-- lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : +-- (sortModel α).evalQuery (cmpLT x y) ↔ x < y := by +-- simp [sortModel] + +-- lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : +-- (sortModel α).evalQuery (insertHead l x) = x :: l := by +-- simp [sortModel] + +-- lemma SortModel_addComponents [LinearOrder α] (m₁ m₂ m₃ : SortOpsCost) : +-- m₁ + m₂ = m₃ ↔ +-- m₁.compares + m₂.compares = m₃.compares ∧ +-- m₁.inserts + m₂.inserts = m₃.inserts ∧ +-- m₁.pure + m₂.pure = m₃.pure := by +-- simp only [HAdd.hAdd, addSortOps] +-- simp only [instAddNat, Nat.add_eq] +-- aesop + +-- lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : +-- m₁ ≤ m₂ ↔ +-- m₁.compares ≤ m₂.compares ∧ +-- m₁.inserts ≤ m₂.inserts ∧ +-- m₁.pure ≤ m₂.pure := by +-- simp only [LE.le] @[simp, grind] -instance pcSortOps : PureCosts SortOpsCost where - pureCost := ⟨0,0,1⟩ - -@[simp, grind] -instance zeroSortOps : Zero SortOpsCost := ⟨0,0,0⟩ - -@[simp, grind] -instance addSortOps : Add SortOpsCost where - add | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => ⟨c₁ + c₂, i₁ + i₂, p₁ + p₂⟩ - -@[simp] -instance partialOrderSortOps : PartialOrder SortOpsCost where - le | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ ∧ p₁ ≤ p₂ - le_refl := by - intro c - simp only [le_refl, and_self] - le_trans a b c := by - simp only [and_imp] - intro ab_comps ab_inserts ab_pures bc_comps bc_inserts bc_pures - refine ⟨?_, ?_, ?_⟩ - all_goals solve_by_elim [Nat.le_trans] - le_antisymm := by - intro ⟨a_comps, a_inserts, a_pures⟩ ⟨b_comps, b_inserts, b_pures⟩ - simp only [SortOpsCost.mk.injEq, and_imp] - intro ab_comps ab_inserts ab_pures ba_comps ba_inserts ba_pures - refine ⟨?_, ?_, ?_⟩ - all_goals solve_by_elim[Nat.le_antisymm] - - -@[simp, grind] -def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where +def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where evalQuery q := match q with | .cmpLT x y => @@ -74,139 +112,113 @@ def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost wher | .insertHead l x => x :: l cost q := match q with - | .cmpLT _ _ => ⟨1,0,0⟩ - | .insertHead _ _ => ⟨0,1,0⟩ - -lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : - (sortModel α).evalQuery (cmpLT x y) ↔ x < y := by - simp [sortModel] - -lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : - (sortModel α).evalQuery (insertHead l x) = x :: l := by - simp [sortModel] - -lemma SortModel_addComponents [LinearOrder α] (m₁ m₂ m₃ : SortOpsCost) : - m₁ + m₂ = m₃ ↔ - m₁.compares + m₂.compares = m₃.compares ∧ - m₁.inserts + m₂.inserts = m₃.inserts ∧ - m₁.pure + m₂.pure = m₃.pure := by - simp only [HAdd.hAdd, addSortOps] - simp only [instAddNat, Nat.add_eq] - aesop - -lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : - m₁ ≤ m₂ ↔ - m₁.compares ≤ m₂.compares ∧ - m₁.inserts ≤ m₂.inserts ∧ - m₁.pure ≤ m₂.pure := by - simp only [LE.le] - -def insertOrdNaive (l : List α) [LinearOrder α] (x : α) := + | .cmpLT _ _ => 1 + | .insertHead _ _ => 1 + +def insertOrdNaive (x : α) (l : List α) [LinearOrder α] := match l with | [] => [x] - | a :: as => if a < x then insertOrdNaive as x else x :: (a :: as) - + | a :: as => if a < x then a :: insertOrdNaive x as else x :: (a :: as) -lemma insertOrdNaive_sorted [LinearOrder α] (l : List α) (x : α) : - Monotone l.get → Monotone (insertOrdNaive l x).get := by - intro l_mono +lemma insertOrdNaive_mem [LinearOrder α] + (x y : α) (l : List α) (hx : x ∈ insertOrdNaive y l) : x = y ∨ x ∈ l := by induction l with | nil => - simp_all [Monotone] + simp only [insertOrdNaive, List.mem_cons, List.not_mem_nil, or_false] at hx + left + exact hx | cons head tail ih => - have ltail_mono := List_Monotone_tail tail head l_mono - specialize ih ltail_mono - simp only [insertOrdNaive] - split_ifs with h_head - · grind - · apply List_Monotone_cons at l_mono - case x => exact x - all_goals grind - - -def insertOrd (l : List α) (x : α) : Prog (SortOps α) (List α) := do + simp_all only [insertOrdNaive, List.mem_cons] + split_ifs at hx with h_head + · simp only [List.mem_cons] at hx + obtain (hx | hx) := hx + · tauto + · specialize ih hx + tauto + · simp at hx + assumption + + +lemma insertOrdNaive_sorted [LinearOrder α] (x : α) (l : List α) : + l.Pairwise (· ≤ ·) → (insertOrdNaive x l).Pairwise (· ≤ ·) := by + intro h + induction l with + | nil => + cases h with + | nil => simp [insertOrdNaive] + | cons head tail ih => + cases h with + | cons h₁ h₂ => + specialize ih h₂ + simp only [insertOrdNaive] + split_ifs with h_head + · simp only [List.pairwise_cons, ih, and_true] + intro a ha + apply insertOrdNaive_mem at ha + obtain (ha | ha) := ha + · grind + · grind + · simp only [List.pairwise_cons, List.mem_cons, forall_eq_or_imp, h₂, and_true] + grind + + +def insertOrd (x : α) (l : List α) : Prog (SortOps α) (List α) := do match l with | [] => insertHead l x | a :: as => let cmp : Bool ← cmpLT a x if cmp then - insertOrd as x + let res ← insertOrd x as + insertHead res a else insertHead (a :: as) x + lemma insertOrd_is_insertOrdNaive [LinearOrder α] : - ∀ (l : List α) (x : α), - (insertOrd l x).eval (sortModel α) = insertOrdNaive l x := by - intro l x + ∀ (x : α) (l : List α) , + (insertOrd x l).eval (sortModel α) = insertOrdNaive x l := by + intro x l induction l with | nil => simp_all [insertOrd, insertOrdNaive, Id.run] | cons head tail ih => - simp_all only [Prog.eval, Id.run, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + simp_all only [Prog.eval, Id.run, pure, sortModel, Bool.if_false_right, Bool.and_true, insertOrd, bind, FreeM.lift_def, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq, insertOrdNaive] split_ifs with h_head - · exact ih + · simp only [FreeM.liftM_bind, bind, FreeM.liftM_liftBind, FreeM.liftM_pure, pure, + List.cons.injEq, true_and] + exact ih · simp lemma insertOrd_complexity_upper_bound [LinearOrder α] : ∀ (l : List α) (x : α), - (insertOrd l x).time (sortModel α) ≤ ⟨l.length, 1, 1⟩ := by + (insertOrd x l).time (sortModel α) ≤ 2*l.length + 1 := by intro l x induction l with | nil => simp_all [sortModel, insertOrd, Prog.time, PureCosts.pureCost, HAdd.hAdd, addSortOps] | cons head tail ih => - simp only [insertOrd, bind, FreeM.lift_def, FreeM.liftBind_bind, FreeM.pure_bind, Prog.time, - List.length_cons] - by_cases h_head : head < x - · split_ifs - all_goals - simp only at ih - have h₁ : (⟨tail.length + 1, 1, 1⟩ : SortOpsCost) = ⟨1,0,0⟩ + ⟨tail.length, 1, 1⟩ := by - simp only [HAdd.hAdd, addSortOps, SortOpsCost.mk.injEq, and_self, and_true] - simp only [instAddNat, Nat.add_eq, Nat.add_comm] - rw [h₁] - rw [SortModel_leComponents] at * - refine ⟨?_, ?_, ?_⟩ - all_goals - clear h₁ - apply Nat.add_le_add - · simp - · --replace ih := ih.1 - simp [-sortModel] at ih - grind - · simp only [sortModel, Bool.if_false_right, Bool.and_true, decide_eq_true_eq] - split_ifs - · simp only [partialOrderSortOps, not_and, not_le, addSortOps, Prog.time, - PureCosts.pureCost] - refine ⟨?_, ?_, ?_⟩ - · simp only [HAdd.hAdd] - simp only [instAddNat, Nat.add_eq, add_zero, le_add_iff_nonneg_left, zero_le] - · simp only [HAdd.hAdd] - simp only [instAddNat, Nat.add_eq, add_zero, zero_add, le_refl] - · simp only [HAdd.hAdd, le_refl] + simp_all [insertOrd] + split_ifs + · ring_nf + conv => + lhs + arg 2 + arg 1 + simp [FreeM.liftBind_bind] + done + · done lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : - Monotone l.get → Monotone ((insertOrd l x).eval (sortModel α)).get := by + l.Pairwise (· ≤ ·) → ((insertOrd x l).eval (sortModel α)).Pairwise (· ≤ ·) := by intro l_mono - rw [insertOrd_is_insertOrdNaive l x] - induction l with - | nil => - simp[Monotone] - | cons head tail ih => - specialize ih (List_Monotone_tail tail head l_mono) - simp only [insertOrdNaive] - split_ifs with h_head - · grind - · intro i j hij - simp only [h_head, List.get_eq_getElem, ↓reduceIte] - apply List_Monotone_cons - · grind - · exact l_mono - · grind + rw [insertOrd_is_insertOrdNaive x l] + apply insertOrdNaive_sorted + assumption + end Algorithms end Cslib diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index e6115ce2b..9a51c28ce 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -37,44 +37,8 @@ inductive SortOps (α : Type) : Type → Type where open SortOps -@[ext] -structure SortOpsCost where - compares : ℕ - inserts : ℕ - pure : ℕ - -@[simp, grind] -instance pcSortOps : PureCosts SortOpsCost where - pureCost := ⟨0,0,1⟩ - -@[simp, grind] -instance zeroSortOps : Zero SortOpsCost := ⟨0,0,0⟩ - @[simp, grind] -instance addSortOps : Add SortOpsCost where - add | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => ⟨c₁ + c₂, i₁ + i₂, p₁ + p₂⟩ - -@[simp] -instance partialOrderSortOps : PartialOrder SortOpsCost where - le | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ ∧ p₁ ≤ p₂ - le_refl := by - intro c - simp only [le_refl, and_self] - le_trans a b c := by - simp only [and_imp] - intro ab_comps ab_inserts ab_pures bc_comps bc_inserts bc_pures - refine ⟨?_, ?_, ?_⟩ - all_goals solve_by_elim [Nat.le_trans] - le_antisymm := by - intro ⟨a_comps, a_inserts, a_pures⟩ ⟨b_comps, b_inserts, b_pures⟩ - simp only [SortOpsCost.mk.injEq, and_imp] - intro ab_comps ab_inserts ab_pures ba_comps ba_inserts ba_pures - refine ⟨?_, ?_, ?_⟩ - all_goals solve_by_elim[Nat.le_antisymm] - - -@[simp, grind] -def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where +def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where evalQuery q := match q with | .cmpLT x y => @@ -85,43 +49,8 @@ def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost wher | .insertHead l x => x :: l cost q := match q with - | .cmpLT _ _ => ⟨1,0,0⟩ - | .insertHead _ _ => ⟨0,1,0⟩ - -lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : - (sortModel α).evalQuery (cmpLT x y) ↔ x < y := by - simp [sortModel] - -lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : - (sortModel α).evalQuery (insertHead l x) = x :: l := by - simp [sortModel] - -lemma SortModel_addComponents [LinearOrder α] (m₁ m₂ m₃ : SortOpsCost) : - m₁ + m₂ = m₃ ↔ - m₁.compares + m₂.compares = m₃.compares ∧ - m₁.inserts + m₂.inserts = m₃.inserts ∧ - m₁.pure + m₂.pure = m₃.pure := by - simp only [HAdd.hAdd, addSortOps] - simp only [instAddNat, Nat.add_eq] - aesop - -lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : - m₁ ≤ m₂ ↔ - m₁.compares ≤ m₂.compares ∧ - m₁.inserts ≤ m₂.inserts ∧ - m₁.pure ≤ m₂.pure := by - simp only [LE.le] - -def insertOrdNaive (l : List α) [LinearOrder α] (x : α) := - match l with - | [] => [x] - | a :: as => if a < x then insertOrdNaive as x else x :: (a :: as) - - - - - - + | .cmpLT _ _ => 1 + | .insertHead _ _ => 1 /-- Merge two sorted lists using comparisons in the query monad. -/ @@ -153,14 +82,14 @@ def merge (x y : List α) : Prog (SortOps α) (List α) := do return (y :: rest) lemma merge_timeComplexity [LinearOrder α] (x y : List α) : - (merge x y).time (sortModel α) = ⟨min x.length y.length , 0 ,1⟩ := by + (merge x y).time (sortModel α) = 1 + min x.length y.length := by fun_induction merge - · simp - · simp + · simp [PureCosts.pureCost] + · simp [PureCosts.pureCost] · expose_names simp split_ifs with hxy - · + · simp [time, PureCosts.pureCost] done · done @@ -172,18 +101,18 @@ lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : · expose_names simp [Id.run] · expose_names - simp only [Prog.eval, Id.run, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + simp only [Prog.eval, Id.run, pure, sortModel, Bool.if_false_right, Bool.and_true, merge, bind, FreeM.lift_def, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq] - simp_all only [Prog.eval, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + simp_all only [Prog.eval, pure, sortModel, Bool.if_false_right, Bool.and_true, ↓reduceIte, FreeM.liftM_bind, bind, FreeM.liftM_pure, List.cons.injEq, true_and, rest] exact ih1 - · simp only [Prog.eval, Id.run, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + · simp only [Prog.eval, Id.run, pure, sortModel, Bool.if_false_right, Bool.and_true, merge, bind, FreeM.lift_def, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq] rename_i rest ih1 - simp_all only [not_lt, Prog.eval, pure, addSortOps, zeroSortOps, pcSortOps, sortModel, + simp_all only [not_lt, Prog.eval, pure, sortModel, Bool.if_false_right, Bool.and_true, rest] split next h_1 => @@ -200,13 +129,13 @@ lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : -/-- Split a list into two lists by alternating elements. -/ -def split (xs : List Nat) : List Nat × List Nat := - let rec go : List Nat → List Nat → List Nat → List Nat × List Nat - | [], accL, accR => (accL.reverse, accR.reverse) - | [x], accL, accR => ((x :: accL).reverse, accR.reverse) - | x :: y :: xs, accL, accR => go xs (x :: accL) (y :: accR) - go xs [] [] +-- /-- Split a list into two lists by alternating elements. -/ +-- def split (xs : List Nat) : List Nat × List Nat := +-- let rec go : List Nat → List Nat → List Nat → List Nat × List Nat +-- | [], accL, accR => (accL.reverse, accR.reverse) +-- | [x], accL, accR => ((x :: accL).reverse, accR.reverse) +-- | x :: y :: xs, accL, accR => go xs (x :: accL) (y :: accR) +-- go xs [] [] -- /-- Merge sort expressed as a program in the query model. -- TODO: Working version without partial -/ diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index a591f7f3a..2f017f0be 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -79,6 +79,21 @@ def Prog.time [Add Cost] [Zero Cost] [PureCosts Cost] let qval := M.evalQuery op t₁ + (time (cont qval) M) +lemma Prog.time.bind_pure [iAdd : Add Cost] + [iZero : Zero Cost] [iPC : PureCosts Cost] (M : Model Q Cost) : + Prog.time (FreeM.bind op (fun rest => FreeM.pure x)) M = (Prog.time op M) + pureCost:= by + unfold time + induction op with + | pure a => + simp + sorry + | liftBind op cont ih => + simp + specialize ih (M.evalQuery op) + simp at ih + sorry + + section Reduction structure Reduction (Q₁ Q₂ : Type u → Type u) where diff --git a/Cslib/AlgorithmsTheory/UpstreamLemmas.lean b/Cslib/AlgorithmsTheory/UpstreamLemmas.lean deleted file mode 100644 index dea9cd2a8..000000000 --- a/Cslib/AlgorithmsTheory/UpstreamLemmas.lean +++ /dev/null @@ -1,90 +0,0 @@ -/- -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 - -namespace Cslib - -namespace Algorithms - -lemma List_Monotone_tail [LinearOrder α] (l : List α) (x : α) : - Monotone (x :: l).get → Monotone l.get := by - intro h - simp_all only [Monotone, List.length_cons, List.get_eq_getElem] - intro i j hij - have : i.castSucc + 1 ≤ j.castSucc + 1 := by - simp only [Fin.coeSucc_eq_succ, Fin.succ_le_succ_iff] - exact hij - specialize @h (i.castSucc + 1) (j.castSucc + 1) this - simp_all only [Fin.coeSucc_eq_succ, Fin.val_succ, List.getElem_cons_succ] - -lemma List.cons_get_pred_get (l : List α) (x : α) - (i : Fin (x :: l).length) (hi : i > ⟨0, by grind⟩) : - (x :: l).get i = l.get (i.pred (by aesop)) := by - grind - -lemma List_Monotone_of_cons [LinearOrder α] (tail : List α) (head : α) : - Monotone (head :: tail).get ↔ Monotone tail.get ∧ ∀ y ∈ tail, head ≤ y := by - constructor - · intro mono - constructor - · apply List_Monotone_tail at mono - assumption - · intro y y_tail - obtain ⟨i,hi⟩ := List.get_of_mem y_tail - simp only [Monotone, List.length_cons, List.get_eq_getElem] at mono - specialize @mono 0 (i.castSucc + 1) (by simp) - simp_all - · intro ⟨htail_mono, h_head⟩ i j hij - by_cases hi_eq_j : i = j - · rw [hi_eq_j] - · apply Std.lt_of_le_of_ne at hij - apply hij at hi_eq_j - have s₁ : ⟨0, by grind⟩ < j := by - grind - have s₂ : (head :: tail).get j ∈ tail := by - grind - by_cases hi_zero : i = ⟨0, by grind⟩ - · rw [hi_zero] - simp only [List.length_cons, Fin.zero_eta, List.get_eq_getElem, Fin.coe_ofNat_eq_mod, - Nat.zero_mod, List.getElem_cons_zero, ge_iff_le] - specialize h_head (head :: tail)[↑j] s₂ - exact h_head - · have s₃ : i > ⟨0, by grind⟩ := by - grind - rw [List.cons_get_pred_get, List.cons_get_pred_get] - · apply htail_mono - grind - · exact s₁ - · exact s₃ - -lemma List_Monotone_cons [LinearOrder α] (tail : List α) (x head : α) - (hx : x ≤ head) (h_mono : Monotone (head :: tail).get) : Monotone (x :: head :: tail).get := by - have s₁ : ∀ y ∈ tail, head ≤ y := by - intro x x_in_tail - simp_all [Monotone] - obtain ⟨i, hi⟩ := List.get_of_mem x_in_tail - specialize @h_mono 0 (i.castSucc + 1) (by simp) - simp at h_mono - simp_all - rw [List_Monotone_of_cons] - simp only [List.length_cons, List.mem_cons, forall_eq_or_imp] - constructor - · exact h_mono - · constructor - · grind - · intro y y_in_tail - specialize s₁ y y_in_tail - grind - -end Algorithms - -end Cslib From 4d0b7a1e553c6943ba5b3efcdd5ecab101e3c743 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 17 Feb 2026 01:59:51 +0100 Subject: [PATCH 059/176] AddCommSemigroup is the right Cost structure --- .../Algorithms/ListLinearSearch.lean | 18 +++-- .../Algorithms/ListOrderedInsert.lean | 38 +++++++---- Cslib/AlgorithmsTheory/QueryModel.lean | 68 ++++++++++++++----- 3 files changed, 88 insertions(+), 36 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index 39ab7af0d..cb536b759 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -34,15 +34,23 @@ structure CmpCount where cmp : ℕ pure : ℕ -instance : Add (CmpCount) where +instance cmpCountAdd : Add (CmpCount) where add x y := ⟨x.1 + y.1, x.2 + y.2⟩ instance : Zero (CmpCount) where zero := ⟨0,0⟩ -instance : PureCosts (CmpCount) where +instance : PureCost (CmpCount) where pureCost := ⟨0,1⟩ +instance : AddCommSemigroup (CmpCount) where + add_assoc a b c := by + simp [HAdd.hAdd] + simp [cmpCountAdd, instAddNat, Nat.add_assoc] + add_comm a b := by + simp [HAdd.hAdd] + simp [cmpCountAdd, instAddNat, Nat.add_comm] + def ListSearch_Cmp [DecidableEq α] : Model (ListSearch α) CmpCount where evalQuery q := match q with @@ -103,18 +111,18 @@ lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List intro x induction l with | nil => - simp_all [listLinearSearch, ListSearch_Nat, time, PureCosts.pureCost] + simp_all [listLinearSearch, ListSearch_Nat, time, PureCost.pureCost] | cons head tail ih => simp_all [listLinearSearch, ListSearch_Nat, time] split_ifs with h_head - · simp [time, PureCosts.pureCost] + · simp [time, PureCost.pureCost] · grind lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Nontrivial α] : ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = 1 + l.length := by obtain ⟨x, y, x_neq_y⟩ := inon use [x,x,x,x,x,y], y - simp_all [time, ListSearch_Nat, listLinearSearch, PureCosts.pureCost] + simp_all [time, ListSearch_Nat, listLinearSearch, PureCost.pureCost] end Algorithms end Cslib diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index b9fd0295a..44d08e2e1 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -27,12 +27,12 @@ open SortOps -- @[ext] -- structure SortOpsCost where --- compares : ℕ --- inserts : ℕ --- pure : ℕ +-- compares : ℤ +-- inserts : ℤ +-- pure : ℤ -- @[simp, grind] --- instance pcSortOps : PureCosts SortOpsCost where +-- instance pcSortOps : PureCost SortOpsCost where -- pureCost := ⟨0,0,1⟩ -- @[simp, grind] @@ -52,13 +52,28 @@ open SortOps -- simp only [and_imp] -- intro ab_comps ab_inserts ab_pures bc_comps bc_inserts bc_pures -- refine ⟨?_, ?_, ?_⟩ --- all_goals solve_by_elim [Nat.le_trans] +-- all_goals solve_by_elim [Int.le_trans] -- le_antisymm := by -- intro ⟨a_comps, a_inserts, a_pures⟩ ⟨b_comps, b_inserts, b_pures⟩ -- simp only [SortOpsCost.mk.injEq, and_imp] -- intro ab_comps ab_inserts ab_pures ba_comps ba_inserts ba_pures -- refine ⟨?_, ?_, ?_⟩ --- all_goals solve_by_elim[Nat.le_antisymm] +-- all_goals solve_by_elim[Int.le_antisymm] + +-- instance : CommRing SortOpsCost where +-- add_assoc := by +-- intro a b c +-- simp [HAdd.hAdd, addSortOps] +-- simp [Int.instAdd] +-- refine ⟨?_, ?_, ?_⟩ +-- all_goals apply Int.add_assoc +-- zero_add := by +-- intro ⟨a₁, a₂, a₃⟩ +-- simp [HAdd.hAdd, addSortOps] +-- simp [Int.instAdd] +-- tauto +-- mul a b | SortOpsCost.mk a₁ a₂ a₃, .mk b₁ b₂ b₃ => ⟨a₁*b₁, a₂*b₂, a₃*b₃⟩ + -- @[simp, grind] @@ -195,20 +210,15 @@ lemma insertOrd_is_insertOrdNaive [LinearOrder α] : lemma insertOrd_complexity_upper_bound [LinearOrder α] : ∀ (l : List α) (x : α), - (insertOrd x l).time (sortModel α) ≤ 2*l.length + 1 := by + (insertOrd x l).time (sortModel α) ≤ 2*l.length + 2 := by intro l x induction l with | nil => - simp_all [sortModel, insertOrd, Prog.time, PureCosts.pureCost, HAdd.hAdd, addSortOps] + simp_all [sortModel, insertOrd, Prog.time, PureCost.pureCost, HAdd.hAdd] | cons head tail ih => simp_all [insertOrd] split_ifs - · ring_nf - conv => - lhs - arg 2 - arg 1 - simp [FreeM.liftBind_bind] + · grind done · done diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 2f017f0be..724233ff0 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -48,14 +48,25 @@ query model, free monad, time complexity, Prog namespace Cslib.Algorithms -class PureCosts (α : Type u) where +class PureCost (α : Type u) where pureCost : α -scoped instance : PureCosts ℕ where +open PureCost + +scoped instance : PureCost ℕ where + pureCost := 1 + +scoped instance : PureCost ℤ where + pureCost := 1 + +scoped instance : PureCost ℚ where pureCost := 1 -structure Model (QType : Type u → Type u) (Cost : Type) [Add Cost] [Zero Cost] - [PureCosts Cost] where +scoped instance : PureCost ℝ where + pureCost := 1 + +structure Model (QType : Type u → Type u) (Cost : Type) + [AddCommSemigroup Cost] [PureCost Cost] where evalQuery : QType ι → ι cost : QType ι → Cost @@ -65,34 +76,57 @@ instance {Q α} : Coe (Q α) (FreeM Q α) where coe := FreeM.lift @[simp, grind] -def Prog.eval [Add Cost] [Zero Cost] [PureCosts Cost] +def Prog.eval [AddCommSemigroup Cost] [PureCost Cost] (P : Prog Q α) (M : Model Q Cost) : α := Id.run <| P.liftM fun x => pure (M.evalQuery x) @[simp, grind] -def Prog.time [Add Cost] [Zero Cost] [PureCosts Cost] +def Prog.time [AddCommSemigroup Cost] [PureCost Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := match P with - | .pure _ => PureCosts.pureCost + | .pure _ => pureCost | .liftBind op cont => let t₁ := M.cost op let qval := M.evalQuery op t₁ + (time (cont qval) M) -lemma Prog.time.bind_pure [iAdd : Add Cost] - [iZero : Zero Cost] [iPC : PureCosts Cost] (M : Model Q Cost) : - Prog.time (FreeM.bind op (fun rest => FreeM.pure x)) M = (Prog.time op M) + pureCost:= by - unfold time +@[simp, grind =] +lemma Prog.time.bind_pure [AddCommSemigroup Cost] [iPC : PureCost Cost] (M : Model Q Cost) : + Prog.time (op >>= FreeM.pure) M = (Prog.time op M) := by + simp only [bind, FreeM.bind_pure] + +@[simp, grind =] +lemma Prog.time.pure_bind + [iZero : CommRing Cost] [iPC : PureCost Cost] (M : Model Q Cost) : + Prog.time (FreeM.pure x >>= m) M = (m x).time M := by + rfl + +@[simp, grind =] +lemma Prog.time.bind [AddCommSemigroup Cost] [iPC : PureCost Cost] (M : Model Q Cost) + (op : Prog Q ι) (cont : ι → Prog Q α) : + Prog.time (op >>= cont) M + pureCost = + (Prog.time op M) + (Prog.time (cont (Prog.eval op M)) M):= by + simp only [Bind.bind, eval, pure] induction op with | pure a => - simp - sorry - | liftBind op cont ih => + simp [Id.run, AddCommSemigroup.add_comm] + | liftBind op cont' ih => simp specialize ih (M.evalQuery op) - simp at ih - sorry - + grind + +@[simp, grind =] +lemma Prog.time.liftBind [AddCommSemigroup Cost] [iPC : PureCost Cost] (M : Model Q Cost) + (op : Q ι) (cont : ι → Prog Q α) : + Prog.time (.liftBind op cont) M + pureCost = + (Prog.time (FreeM.lift op) M) + (Prog.time (cont (M.evalQuery op)) M):= by + simp only [time, FreeM.lift_def] + conv => + rhs + rw [AddSemigroup.add_assoc] + arg 2 + rw [AddCommSemigroup.add_comm] + grind section Reduction From 86b608cb146e9c6f39b61fe921aa4a7927ef6dc6 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 17 Feb 2026 16:25:38 +0100 Subject: [PATCH 060/176] AddCommSemigroup --- .../Algorithms/ListOrderedInsert.lean | 205 +++++++++--------- Cslib/AlgorithmsTheory/QueryModel.lean | 1 + 2 files changed, 108 insertions(+), 98 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 44d08e2e1..7d92d4c33 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -25,98 +25,61 @@ inductive SortOps (α : Type) : Type → Type where open SortOps --- @[ext] --- structure SortOpsCost where --- compares : ℤ --- inserts : ℤ --- pure : ℤ - --- @[simp, grind] --- instance pcSortOps : PureCost SortOpsCost where --- pureCost := ⟨0,0,1⟩ - --- @[simp, grind] --- instance zeroSortOps : Zero SortOpsCost := ⟨0,0,0⟩ - --- @[simp, grind] --- instance addSortOps : Add SortOpsCost where --- add | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => ⟨c₁ + c₂, i₁ + i₂, p₁ + p₂⟩ - --- @[simp] --- instance partialOrderSortOps : PartialOrder SortOpsCost where --- le | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ ∧ p₁ ≤ p₂ --- le_refl := by --- intro c --- simp only [le_refl, and_self] --- le_trans a b c := by --- simp only [and_imp] --- intro ab_comps ab_inserts ab_pures bc_comps bc_inserts bc_pures --- refine ⟨?_, ?_, ?_⟩ --- all_goals solve_by_elim [Int.le_trans] --- le_antisymm := by --- intro ⟨a_comps, a_inserts, a_pures⟩ ⟨b_comps, b_inserts, b_pures⟩ --- simp only [SortOpsCost.mk.injEq, and_imp] --- intro ab_comps ab_inserts ab_pures ba_comps ba_inserts ba_pures --- refine ⟨?_, ?_, ?_⟩ --- all_goals solve_by_elim[Int.le_antisymm] - --- instance : CommRing SortOpsCost where --- add_assoc := by --- intro a b c --- simp [HAdd.hAdd, addSortOps] --- simp [Int.instAdd] --- refine ⟨?_, ?_, ?_⟩ --- all_goals apply Int.add_assoc --- zero_add := by --- intro ⟨a₁, a₂, a₃⟩ --- simp [HAdd.hAdd, addSortOps] --- simp [Int.instAdd] --- tauto --- mul a b | SortOpsCost.mk a₁ a₂ a₃, .mk b₁ b₂ b₃ => ⟨a₁*b₁, a₂*b₂, a₃*b₃⟩ - - - --- @[simp, grind] --- def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where --- evalQuery q := --- match q with --- | .cmpLT x y => --- if x < y then --- true --- else --- false --- | .insertHead l x => x :: l --- cost q := --- match q with --- | .cmpLT _ _ => ⟨1,0,0⟩ --- | .insertHead _ _ => ⟨0,1,0⟩ - --- lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : --- (sortModel α).evalQuery (cmpLT x y) ↔ x < y := by --- simp [sortModel] - --- lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : --- (sortModel α).evalQuery (insertHead l x) = x :: l := by --- simp [sortModel] - --- lemma SortModel_addComponents [LinearOrder α] (m₁ m₂ m₃ : SortOpsCost) : --- m₁ + m₂ = m₃ ↔ --- m₁.compares + m₂.compares = m₃.compares ∧ --- m₁.inserts + m₂.inserts = m₃.inserts ∧ --- m₁.pure + m₂.pure = m₃.pure := by --- simp only [HAdd.hAdd, addSortOps] --- simp only [instAddNat, Nat.add_eq] --- aesop - --- lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : --- m₁ ≤ m₂ ↔ --- m₁.compares ≤ m₂.compares ∧ --- m₁.inserts ≤ m₂.inserts ∧ --- m₁.pure ≤ m₂.pure := by --- simp only [LE.le] +@[ext] +structure SortOpsCost where + compares : ℤ + inserts : ℤ + pure : ℤ @[simp, grind] -def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where +instance pcSortOps : PureCost SortOpsCost where + pureCost := ⟨0,0,1⟩ + +@[simp, grind] +instance zeroSortOps : Zero SortOpsCost := ⟨0,0,0⟩ + + +@[simp] +instance partialOrderSortOps : PartialOrder SortOpsCost where + le | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ ∧ p₁ ≤ p₂ + le_refl := by + intro c + simp only [le_refl, and_self] + le_trans a b c := by + simp only [and_imp] + intro ab_comps ab_inserts ab_pures bc_comps bc_inserts bc_pures + refine ⟨?_, ?_, ?_⟩ + all_goals solve_by_elim [Int.le_trans] + le_antisymm := by + intro ⟨a_comps, a_inserts, a_pures⟩ ⟨b_comps, b_inserts, b_pures⟩ + simp only [SortOpsCost.mk.injEq, and_imp] + intro ab_comps ab_inserts ab_pures ba_comps ba_inserts ba_pures + refine ⟨?_, ?_, ?_⟩ + all_goals solve_by_elim[Int.le_antisymm] + +def add : SortOpsCost → SortOpsCost → SortOpsCost + | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => ⟨c₁ + c₂, i₁ + i₂, p₁ + p₂⟩ + +def nsmul (n : ℕ) (x : SortOpsCost) : SortOpsCost := + match n with + | 0 => 0 + | m + 1 => add x (nsmul m x) + +instance acsSortOpsCost : AddCommSemigroup SortOpsCost where + add := add + add_assoc := by + intro a b c + simp [HAdd.hAdd] + simp [add, Int.instAdd, Int.add_assoc] + add_comm := by + intro a b + simp [HAdd.hAdd] + simp [add, Int.instAdd, Int.add_comm] + + + +@[simp, grind] +def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where evalQuery q := match q with | .cmpLT x y => @@ -127,8 +90,34 @@ def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where | .insertHead l x => x :: l cost q := match q with - | .cmpLT _ _ => 1 - | .insertHead _ _ => 1 + | .cmpLT _ _ => ⟨1,0,0⟩ + | .insertHead _ _ => ⟨0,1,0⟩ + +lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : + (sortModel α).evalQuery (cmpLT x y) ↔ x < y := by + simp [sortModel] + +lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : + (sortModel α).evalQuery (insertHead l x) = x :: l := by + simp [sortModel] + +lemma SortModel_addComponents [LinearOrder α] (m₁ m₂ m₃ : SortOpsCost) : + m₁ + m₂ = m₃ ↔ + m₁.compares + m₂.compares = m₃.compares ∧ + m₁.inserts + m₂.inserts = m₃.inserts ∧ + m₁.pure + m₂.pure = m₃.pure := by + simp only [HAdd.hAdd] + simp only [Int.instAdd] + aesop + +lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : + m₁ ≤ m₂ ↔ + m₁.compares ≤ m₂.compares ∧ + m₁.inserts ≤ m₂.inserts ∧ + m₁.pure ≤ m₂.pure := by + simp only [LE.le] + + def insertOrdNaive (x : α) (l : List α) [LinearOrder α] := match l with @@ -210,17 +199,37 @@ lemma insertOrd_is_insertOrdNaive [LinearOrder α] : lemma insertOrd_complexity_upper_bound [LinearOrder α] : ∀ (l : List α) (x : α), - (insertOrd x l).time (sortModel α) ≤ 2*l.length + 2 := by + (insertOrd x l).time (sortModel α) ≤ ⟨l.length, l.length + 1, 1⟩ := by intro l x induction l with | nil => - simp_all [sortModel, insertOrd, Prog.time, PureCost.pureCost, HAdd.hAdd] + simp_all [sortModel, insertOrd, Prog.time, PureCost.pureCost, + HAdd.hAdd] + simp [Add.add] | cons head tail ih => simp_all [insertOrd] - split_ifs - · grind - done - · done + split_ifs with h_head + · obtain ⟨h₁,h₂, h₃⟩ := ih + refine ⟨?_, ?_, ?_⟩ + · clear h₂ h₃ + simp [HAdd.hAdd, acsSortOpsCost, Int.instRing] + conv => + lhs + arg 1 + arg 2 + done + · clear h₁ h₃ + done + · clear h₁ h₂ + done + · obtain ⟨h₁, h₂, h₃⟩ := ih + refine ⟨?_, ?_, ?_⟩ + · clear h₂ h₃ + done + · clear h₁ h₃ + done + · clear h₁ h₂ + done lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : l.Pairwise (· ≤ ·) → ((insertOrd x l).eval (sortModel α)).Pairwise (· ≤ ·) := by diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 724233ff0..1b3f66983 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -126,6 +126,7 @@ lemma Prog.time.liftBind [AddCommSemigroup Cost] [iPC : PureCost Cost] (M : Mode rw [AddSemigroup.add_assoc] arg 2 rw [AddCommSemigroup.add_comm] + grind section Reduction From cba2fbacec11fa56c9bade68f75e47da00e7d994 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 17 Feb 2026 17:13:49 +0100 Subject: [PATCH 061/176] pull main branch --- Cslib/AlgorithmsTheory/QueryModel.lean | 1 - 1 file changed, 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 1b3f66983..724233ff0 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -126,7 +126,6 @@ lemma Prog.time.liftBind [AddCommSemigroup Cost] [iPC : PureCost Cost] (M : Mode rw [AddSemigroup.add_assoc] arg 2 rw [AddCommSemigroup.add_comm] - grind section Reduction From ea0f6bb6b1ec7c0002fa2fae03b7053d1d33e586 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 17 Feb 2026 17:16:07 +0100 Subject: [PATCH 062/176] Sorry out proofs for now --- .../Algorithms/ListOrderedInsert.lean | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 7d92d4c33..38213772a 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -206,6 +206,7 @@ lemma insertOrd_complexity_upper_bound [LinearOrder α] : simp_all [sortModel, insertOrd, Prog.time, PureCost.pureCost, HAdd.hAdd] simp [Add.add] + sorry | cons head tail ih => simp_all [insertOrd] split_ifs with h_head @@ -217,19 +218,19 @@ lemma insertOrd_complexity_upper_bound [LinearOrder α] : lhs arg 1 arg 2 - done + sorry · clear h₁ h₃ - done + sorry · clear h₁ h₂ - done + sorry · obtain ⟨h₁, h₂, h₃⟩ := ih refine ⟨?_, ?_, ?_⟩ · clear h₂ h₃ - done + sorry · clear h₁ h₃ - done + sorry · clear h₁ h₂ - done + sorry lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : l.Pairwise (· ≤ ·) → ((insertOrd x l).eval (sortModel α)).Pairwise (· ≤ ·) := by From b4de3d555cad0dcbb02a13830fcc7389e3db6432 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 17 Feb 2026 18:51:03 +0100 Subject: [PATCH 063/176] The proof of insertOrd_complexity_upper_bound is AI slop. But it suggests some useful API lemmas --- .../Algorithms/ListOrderedInsert.lean | 102 +++++++++++++++--- 1 file changed, 89 insertions(+), 13 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 38213772a..0ab049ce2 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -201,36 +201,112 @@ lemma insertOrd_complexity_upper_bound [LinearOrder α] : ∀ (l : List α) (x : α), (insertOrd x l).time (sortModel α) ≤ ⟨l.length, l.length + 1, 1⟩ := by intro l x + have add_compares (a b : SortOpsCost) : (Add.add a b).compares = a.compares + b.compares := by + cases a; cases b; rfl + have add_inserts (a b : SortOpsCost) : (Add.add a b).inserts = a.inserts + b.inserts := by + cases a; cases b; rfl + have add_pure (a b : SortOpsCost) : (Add.add a b).pure = a.pure + b.pure := by + cases a; cases b; rfl + have add_compares' (a b : SortOpsCost) : (add a b).compares = a.compares + b.compares := by + cases a; cases b; rfl + have add_inserts' (a b : SortOpsCost) : (add a b).inserts = a.inserts + b.inserts := by + cases a; cases b; rfl + have add_pure' (a b : SortOpsCost) : (add a b).pure = a.pure + b.pure := by + cases a; cases b; rfl induction l with | nil => simp_all [sortModel, insertOrd, Prog.time, PureCost.pureCost, HAdd.hAdd] simp [Add.add] - sorry | cons head tail ih => - simp_all [insertOrd] + simp_all only [partialOrderSortOps, not_and, not_le, pcSortOps, sortModel, + Bool.if_false_right, Bool.and_true, insertOrd, bind, FreeM.lift_def, FreeM.liftBind_bind, + FreeM.pure_bind, time, decide_eq_true_eq, List.length_cons, Nat.cast_add, Nat.cast_one] split_ifs with h_head · obtain ⟨h₁,h₂, h₃⟩ := ih + have hbind_compares : + (Prog.time + (FreeM.bind (insertOrd x tail) + (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + (sortModel α)).compares = + (Prog.time (insertOrd x tail) (sortModel α)).compares := by + have h := congrArg SortOpsCost.compares + (Prog.time.bind (M := sortModel α) + (op := insertOrd x tail) + (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, bind, sortModel, Bool.if_false_right, + Bool.and_true, PureCost.pureCost, add_compares, time, eval, pure] at h + simp [Add.add] at h + exact h + have hbind_inserts : + (Prog.time + (FreeM.bind (insertOrd x tail) + (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + (sortModel α)).inserts = + (Prog.time (insertOrd x tail) (sortModel α)).inserts + 1 := by + have h := congrArg SortOpsCost.inserts + (Prog.time.bind (M := sortModel α) + (op := insertOrd x tail) + (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, bind, sortModel, Bool.if_false_right, + Bool.and_true, PureCost.pureCost, add_inserts, time, eval, pure] at h + simp [Add.add] at h + exact h + have hbind_pure : + (Prog.time + (FreeM.bind (insertOrd x tail) + (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + (sortModel α)).pure = + (Prog.time (insertOrd x tail) (sortModel α)).pure := by + have h := congrArg SortOpsCost.pure + (Prog.time.bind (M := sortModel α) + (op := insertOrd x tail) + (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, bind, sortModel, Bool.if_false_right, + Bool.and_true, PureCost.pureCost, add_pure, time, eval, pure] at h + simp only [Add.add, Int.add_def, zero_add, add_left_inj] at h + exact h refine ⟨?_, ?_, ?_⟩ · clear h₂ h₃ - simp [HAdd.hAdd, acsSortOpsCost, Int.instRing] - conv => - lhs - arg 1 - arg 2 - sorry + simp [HAdd.hAdd, acsSortOpsCost, add_compares] + change (Add.add 1 + (time (FreeM.bind (insertOrd x tail) fun res => + FreeM.liftBind (insertHead res head) FreeM.pure) (sortModel α)).compares ≤ + Add.add (↑tail.length) 1) + rw [hbind_compares] + simp [Add.add] + linarith [h₁] · clear h₁ h₃ - sorry + simp [HAdd.hAdd, acsSortOpsCost, add_inserts] + change (Add.add 0 + (time (FreeM.bind (insertOrd x tail) fun res => + FreeM.liftBind (insertHead res head) FreeM.pure) (sortModel α)).inserts ≤ + Add.add (Add.add (↑tail.length) 1) 1) + rw [hbind_inserts] + simp [Add.add] + linarith [h₂] · clear h₁ h₂ - sorry + simp [HAdd.hAdd, acsSortOpsCost, add_pure] + change (Add.add 0 + (time (FreeM.bind (insertOrd x tail) fun res => + FreeM.liftBind (insertHead res head) FreeM.pure) (sortModel α)).pure ≤ + 1) + rw [hbind_pure] + simpa [Add.add] using h₃ · obtain ⟨h₁, h₂, h₃⟩ := ih refine ⟨?_, ?_, ?_⟩ · clear h₂ h₃ - sorry + simp [HAdd.hAdd, acsSortOpsCost, add_compares] + simp [Add.add] · clear h₁ h₃ - sorry + simp [HAdd.hAdd, acsSortOpsCost, add_inserts] + simp [Add.add] + have h_nonneg : (0 : ℤ) ≤ (tail.length : ℤ) := by + exact Int.natCast_nonneg _ + linarith · clear h₁ h₂ - sorry + simp [HAdd.hAdd, acsSortOpsCost, add_pure] + simp [Add.add] lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : l.Pairwise (· ≤ ·) → ((insertOrd x l).eval (sortModel α)).Pairwise (· ≤ ·) := by From 16466dc0717f1161fdb4c6c9825b2ca83d466598 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 17 Feb 2026 18:51:53 +0100 Subject: [PATCH 064/176] The proof of insertOrd_complexity_upper_bound is AI slop. But it suggests some useful API lemmas --- .../AlgorithmsTheory/Algorithms/ListOrderedInsert.lean | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 0ab049ce2..99e012bb5 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -236,7 +236,7 @@ lemma insertOrd_complexity_upper_bound [LinearOrder α] : (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, bind, sortModel, Bool.if_false_right, Bool.and_true, PureCost.pureCost, add_compares, time, eval, pure] at h - simp [Add.add] at h + simp only [Add.add, Int.add_def, add_zero] at h exact h have hbind_inserts : (Prog.time @@ -250,7 +250,7 @@ lemma insertOrd_complexity_upper_bound [LinearOrder α] : (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, bind, sortModel, Bool.if_false_right, Bool.and_true, PureCost.pureCost, add_inserts, time, eval, pure] at h - simp [Add.add] at h + simp only [Add.add, Int.add_def, add_zero] at h exact h have hbind_pure : (Prog.time @@ -268,7 +268,7 @@ lemma insertOrd_complexity_upper_bound [LinearOrder α] : exact h refine ⟨?_, ?_, ?_⟩ · clear h₂ h₃ - simp [HAdd.hAdd, acsSortOpsCost, add_compares] + simp only [HAdd.hAdd, acsSortOpsCost, add_compares] change (Add.add 1 (time (FreeM.bind (insertOrd x tail) fun res => FreeM.liftBind (insertHead res head) FreeM.pure) (sortModel α)).compares ≤ @@ -277,7 +277,7 @@ lemma insertOrd_complexity_upper_bound [LinearOrder α] : simp [Add.add] linarith [h₁] · clear h₁ h₃ - simp [HAdd.hAdd, acsSortOpsCost, add_inserts] + simp only [HAdd.hAdd, acsSortOpsCost, add_inserts] change (Add.add 0 (time (FreeM.bind (insertOrd x tail) fun res => FreeM.liftBind (insertHead res head) FreeM.pure) (sortModel α)).inserts ≤ @@ -286,7 +286,7 @@ lemma insertOrd_complexity_upper_bound [LinearOrder α] : simp [Add.add] linarith [h₂] · clear h₁ h₂ - simp [HAdd.hAdd, acsSortOpsCost, add_pure] + simp only [HAdd.hAdd, acsSortOpsCost, add_pure] change (Add.add 0 (time (FreeM.bind (insertOrd x tail) fun res => FreeM.liftBind (insertHead res head) FreeM.pure) (sortModel α)).pure ≤ From 12bc143e53df184d45e5bdbbc5879c69206857ba Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Feb 2026 00:50:00 +0100 Subject: [PATCH 065/176] Extract nice lemmas --- .../Algorithms/ListOrderedInsert.lean | 132 ++++++++++-------- 1 file changed, 70 insertions(+), 62 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 99e012bb5..8f5805148 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -25,7 +25,7 @@ inductive SortOps (α : Type) : Type → Type where open SortOps -@[ext] +@[ext, grind] structure SortOpsCost where compares : ℤ inserts : ℤ @@ -93,15 +93,18 @@ def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost wher | .cmpLT _ _ => ⟨1,0,0⟩ | .insertHead _ _ => ⟨0,1,0⟩ +@[grind =] lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : (sortModel α).evalQuery (cmpLT x y) ↔ x < y := by simp [sortModel] +@[grind =] lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : (sortModel α).evalQuery (insertHead l x) = x :: l := by simp [sortModel] -lemma SortModel_addComponents [LinearOrder α] (m₁ m₂ m₃ : SortOpsCost) : + +lemma SortModel_addComponents (m₁ m₂ m₃ : SortOpsCost) : m₁ + m₂ = m₃ ↔ m₁.compares + m₂.compares = m₃.compares ∧ m₁.inserts + m₂.inserts = m₃.inserts ∧ @@ -110,6 +113,21 @@ lemma SortModel_addComponents [LinearOrder α] (m₁ m₂ m₃ : SortOpsCost) : simp only [Int.instAdd] aesop +@[simp] +lemma SortModel_add_compares (m₁ m₂ : SortOpsCost) : + (Add.add m₁ m₂).compares = m₁.compares + m₂.compares := by + cases m₁; cases m₂; rfl + +@[simp] +lemma SortModel_add_inserts (m₁ m₂ : SortOpsCost) : + (Add.add m₁ m₂).inserts = m₁.inserts + m₂.inserts := by + cases m₁; cases m₂; rfl + +@[simp] +lemma SortModel_add_pure (m₁ m₂ : SortOpsCost) : + (Add.add m₁ m₂).pure = m₁.pure + m₂.pure := by + cases m₁; cases m₂; rfl + lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : m₁ ≤ m₂ ↔ m₁.compares ≤ m₂.compares ∧ @@ -196,23 +214,55 @@ lemma insertOrd_is_insertOrdNaive [LinearOrder α] : exact ih · simp +lemma hbind_compares [LinearOrder α] : + (Prog.time + (FreeM.bind (insertOrd x tail) + (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + (sortModel α)).compares = + (Prog.time (insertOrd x tail) (sortModel α)).compares := by + have h := congrArg SortOpsCost.compares + (Prog.time.bind (M := sortModel α) + (op := insertOrd x tail) + (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, bind, sortModel, Bool.if_false_right, + Bool.and_true, PureCost.pureCost, SortModel_add_compares, time, eval, pure] at h + simp only [Add.add, Int.add_def, add_zero] at h + exact h + +lemma hbind_inserts [LinearOrder α] : + (Prog.time + (FreeM.bind (insertOrd x tail) + (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + (sortModel α)).inserts = + (Prog.time (insertOrd x tail) (sortModel α)).inserts + 1 := by + have h := congrArg SortOpsCost.inserts + (Prog.time.bind (M := sortModel α) + (op := insertOrd x tail) + (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, bind, sortModel, Bool.if_false_right, + Bool.and_true, PureCost.pureCost, SortModel_add_inserts, time, eval, pure] at h + simp only [Add.add, Int.add_def, add_zero] at h + exact h + +lemma hbind_pure [LinearOrder α]: + (Prog.time + (FreeM.bind (insertOrd x tail) + (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + (sortModel α)).pure = + (Prog.time (insertOrd x tail) (sortModel α)).pure := by + have h := congrArg SortOpsCost.pure + (Prog.time.bind (M := sortModel α) + (op := insertOrd x tail) + (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, bind, sortModel, Bool.if_false_right, + Bool.and_true, PureCost.pureCost, SortModel_add_pure, time, eval, pure] at h + simp only [Add.add, Int.add_def, zero_add, add_left_inj] at h + exact h lemma insertOrd_complexity_upper_bound [LinearOrder α] : ∀ (l : List α) (x : α), (insertOrd x l).time (sortModel α) ≤ ⟨l.length, l.length + 1, 1⟩ := by intro l x - have add_compares (a b : SortOpsCost) : (Add.add a b).compares = a.compares + b.compares := by - cases a; cases b; rfl - have add_inserts (a b : SortOpsCost) : (Add.add a b).inserts = a.inserts + b.inserts := by - cases a; cases b; rfl - have add_pure (a b : SortOpsCost) : (Add.add a b).pure = a.pure + b.pure := by - cases a; cases b; rfl - have add_compares' (a b : SortOpsCost) : (add a b).compares = a.compares + b.compares := by - cases a; cases b; rfl - have add_inserts' (a b : SortOpsCost) : (add a b).inserts = a.inserts + b.inserts := by - cases a; cases b; rfl - have add_pure' (a b : SortOpsCost) : (add a b).pure = a.pure + b.pure := by - cases a; cases b; rfl induction l with | nil => simp_all [sortModel, insertOrd, Prog.time, PureCost.pureCost, @@ -224,51 +274,9 @@ lemma insertOrd_complexity_upper_bound [LinearOrder α] : FreeM.pure_bind, time, decide_eq_true_eq, List.length_cons, Nat.cast_add, Nat.cast_one] split_ifs with h_head · obtain ⟨h₁,h₂, h₃⟩ := ih - have hbind_compares : - (Prog.time - (FreeM.bind (insertOrd x tail) - (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) - (sortModel α)).compares = - (Prog.time (insertOrd x tail) (sortModel α)).compares := by - have h := congrArg SortOpsCost.compares - (Prog.time.bind (M := sortModel α) - (op := insertOrd x tail) - (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) - simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, bind, sortModel, Bool.if_false_right, - Bool.and_true, PureCost.pureCost, add_compares, time, eval, pure] at h - simp only [Add.add, Int.add_def, add_zero] at h - exact h - have hbind_inserts : - (Prog.time - (FreeM.bind (insertOrd x tail) - (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) - (sortModel α)).inserts = - (Prog.time (insertOrd x tail) (sortModel α)).inserts + 1 := by - have h := congrArg SortOpsCost.inserts - (Prog.time.bind (M := sortModel α) - (op := insertOrd x tail) - (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) - simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, bind, sortModel, Bool.if_false_right, - Bool.and_true, PureCost.pureCost, add_inserts, time, eval, pure] at h - simp only [Add.add, Int.add_def, add_zero] at h - exact h - have hbind_pure : - (Prog.time - (FreeM.bind (insertOrd x tail) - (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) - (sortModel α)).pure = - (Prog.time (insertOrd x tail) (sortModel α)).pure := by - have h := congrArg SortOpsCost.pure - (Prog.time.bind (M := sortModel α) - (op := insertOrd x tail) - (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) - simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, bind, sortModel, Bool.if_false_right, - Bool.and_true, PureCost.pureCost, add_pure, time, eval, pure] at h - simp only [Add.add, Int.add_def, zero_add, add_left_inj] at h - exact h refine ⟨?_, ?_, ?_⟩ · clear h₂ h₃ - simp only [HAdd.hAdd, acsSortOpsCost, add_compares] + simp only [HAdd.hAdd, acsSortOpsCost, SortModel_add_compares] change (Add.add 1 (time (FreeM.bind (insertOrd x tail) fun res => FreeM.liftBind (insertHead res head) FreeM.pure) (sortModel α)).compares ≤ @@ -277,7 +285,7 @@ lemma insertOrd_complexity_upper_bound [LinearOrder α] : simp [Add.add] linarith [h₁] · clear h₁ h₃ - simp only [HAdd.hAdd, acsSortOpsCost, add_inserts] + simp only [HAdd.hAdd, acsSortOpsCost, SortModel_add_inserts] change (Add.add 0 (time (FreeM.bind (insertOrd x tail) fun res => FreeM.liftBind (insertHead res head) FreeM.pure) (sortModel α)).inserts ≤ @@ -286,7 +294,7 @@ lemma insertOrd_complexity_upper_bound [LinearOrder α] : simp [Add.add] linarith [h₂] · clear h₁ h₂ - simp only [HAdd.hAdd, acsSortOpsCost, add_pure] + simp only [HAdd.hAdd, acsSortOpsCost, SortModel_add_pure] change (Add.add 0 (time (FreeM.bind (insertOrd x tail) fun res => FreeM.liftBind (insertHead res head) FreeM.pure) (sortModel α)).pure ≤ @@ -296,16 +304,16 @@ lemma insertOrd_complexity_upper_bound [LinearOrder α] : · obtain ⟨h₁, h₂, h₃⟩ := ih refine ⟨?_, ?_, ?_⟩ · clear h₂ h₃ - simp [HAdd.hAdd, acsSortOpsCost, add_compares] + simp [HAdd.hAdd, acsSortOpsCost, SortModel_add_compares] simp [Add.add] · clear h₁ h₃ - simp [HAdd.hAdd, acsSortOpsCost, add_inserts] + simp [HAdd.hAdd, acsSortOpsCost, SortModel_add_inserts] simp [Add.add] have h_nonneg : (0 : ℤ) ≤ (tail.length : ℤ) := by exact Int.natCast_nonneg _ linarith · clear h₁ h₂ - simp [HAdd.hAdd, acsSortOpsCost, add_pure] + simp [HAdd.hAdd, acsSortOpsCost, SortModel_add_pure] simp [Add.add] lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : From a9814ba3e792e61142b25b7f33ab5849e1584033 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Feb 2026 00:51:29 +0100 Subject: [PATCH 066/176] Extract nice lemmas --- 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 8f5805148..8e8175232 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -244,7 +244,7 @@ lemma hbind_inserts [LinearOrder α] : simp only [Add.add, Int.add_def, add_zero] at h exact h -lemma hbind_pure [LinearOrder α]: +lemma hbind_pure [LinearOrder α] : (Prog.time (FreeM.bind (insertOrd x tail) (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) From 1d231c7a5389806ca1bff866d2b77b00ae2487c4 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Feb 2026 01:37:07 +0100 Subject: [PATCH 067/176] Insertion Sort done --- .../Algorithms/ListInsertionSort.lean | 80 +++++++++++++++++++ .../Algorithms/ListOrderedInsert.lean | 14 +++- 2 files changed, 92 insertions(+), 2 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index cb7661ddf..be87044e1 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -27,6 +27,86 @@ def insertionSort (l : List α) : Prog (SortOps α) (List α) := let rest ← insertionSort xs insertOrd x rest +theorem insertionSort_sorted [LinearOrder α] (l : List α) : + ((insertionSort l).eval (sortModel α)).Pairwise (· ≤ ·) := by + induction l with + | nil => + simp [insertionSort, Id.run] + | cons head tail ih => + have h := insertOrd_Sorted ((insertionSort tail).eval (sortModel α)) head ih + simp only [eval, Id.run, pure, pcSortOps.eq_1, sortModel, Bool.if_false_right, Bool.and_true, + insertionSort, bind, FreeM.liftM_bind] + exact h + +lemma insertionSort_time_compares [LinearOrder α] (head : α) (tail : List α) : + ((insertionSort (head :: tail)).time (sortModel α)).compares = + ((insertionSort tail).time (sortModel α)).compares + + ((insertOrd head ((insertionSort tail).eval (sortModel α))).time (sortModel α)).compares := by + have h := congrArg SortOpsCost.compares + (Prog.time.bind (M := sortModel α) (insertionSort tail) (fun rest => insertOrd head rest)) + simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, PureCost.pureCost, + SortModel_add_compares] at h + simp only [Add.add, Int.add_def, add_zero] at h + simpa [insertionSort] using h + +lemma insertionSort_time_inserts [LinearOrder α] (head : α) (tail : List α) : + ((insertionSort (head :: tail)).time (sortModel α)).inserts = + ((insertionSort tail).time (sortModel α)).inserts + + ((insertOrd head ((insertionSort tail).eval (sortModel α))).time (sortModel α)).inserts := by + have h := congrArg SortOpsCost.inserts + (Prog.time.bind (M := sortModel α) (insertionSort tail) (fun rest => insertOrd head rest)) + simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, PureCost.pureCost, + SortModel_add_inserts] at h + simp only [Add.add, Int.add_def, add_zero] at h + simpa [insertionSort] using h + +lemma insertionSort_time_pure [LinearOrder α] (head : α) (tail : List α) : + ((insertionSort (head :: tail)).time (sortModel α)).pure + 1 = + ((insertionSort tail).time (sortModel α)).pure + + ((insertOrd head ((insertionSort tail).eval (sortModel α))).time (sortModel α)).pure := by + have h := congrArg SortOpsCost.pure + (Prog.time.bind (M := sortModel α) (insertionSort tail) (fun rest => insertOrd head rest)) + simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, PureCost.pureCost, + SortModel_add_pure] at h + simp only [Add.add, Int.add_def] at h + simpa [insertionSort] using h + +lemma insertionSort_length [LinearOrder α] (l : List α) : + ((insertionSort l).eval (sortModel α)).length = l.length := by + induction l with + | nil => + simp [insertionSort, Prog.eval, Id.run] + | cons head tail ih => + have h := insertOrd_length (x := head) ((insertionSort tail).eval (sortModel α)) + simp [Prog.eval, Id.run] at ih + simpa [insertionSort, Prog.eval, Id.run, bind, FreeM.liftM_bind, ih] using h + +theorem insertionSort_complexity [LinearOrder α] (l : List α) : + ((insertionSort l).time (sortModel α)) + ≤ ⟨l.length * (l.length + 1), (l.length + 1) * (l.length + 2), 1 + l.length⟩ := by + induction l with + | nil => + simp [insertionSort] + | cons head tail ih => + have h := insertOrd_complexity_upper_bound ((insertionSort tail).eval (sortModel α)) head + simp_all only [partialOrderSortOps, not_and, not_le, pcSortOps.eq_1, List.length_cons, + Nat.cast_add, Nat.cast_one, insertionSort_length] + obtain ⟨ih₁,ih₂,ih₃⟩ := ih + obtain ⟨h₁,h₂,h₃⟩ := h + refine ⟨?_, ?_, ?_⟩ + · clear h₂ h₃ + rw [insertionSort_time_compares (head := head) (tail := tail)] + have h_nonneg : (0 : ℤ) ≤ (tail.length : ℤ) := by + exact Int.natCast_nonneg _ + nlinarith [ih₁, h₁, h_nonneg] + · clear h₁ h₃ + rw [insertionSort_time_inserts (head := head) (tail := tail)] + have h_nonneg : (0 : ℤ) ≤ (tail.length : ℤ) := by + exact Int.natCast_nonneg _ + nlinarith [ih₂, h₂, h_nonneg] + · clear h₁ h₂ + have hp := insertionSort_time_pure (head := head) (tail := tail) + nlinarith [ih₃, h₃, hp] end Algorithms diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 8e8175232..a8ebe6571 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -160,6 +160,13 @@ lemma insertOrdNaive_mem [LinearOrder α] · simp at hx assumption +lemma insertOrdNaive_length [LinearOrder α] (x : α) (l : List α) : + (insertOrdNaive x l).length = l.length + 1 := by + induction l with + | nil => + simp [insertOrdNaive] + | cons head tail ih => + by_cases h : head < x <;> simp [insertOrdNaive, h, ih] lemma insertOrdNaive_sorted [LinearOrder α] (x : α) (l : List α) : l.Pairwise (· ≤ ·) → (insertOrdNaive x l).Pairwise (· ≤ ·) := by @@ -183,7 +190,6 @@ lemma insertOrdNaive_sorted [LinearOrder α] (x : α) (l : List α) : · simp only [List.pairwise_cons, List.mem_cons, forall_eq_or_imp, h₂, and_true] grind - def insertOrd (x : α) (l : List α) : Prog (SortOps α) (List α) := do match l with | [] => insertHead l x @@ -196,7 +202,6 @@ def insertOrd (x : α) (l : List α) : Prog (SortOps α) (List α) := do else insertHead (a :: as) x - lemma insertOrd_is_insertOrdNaive [LinearOrder α] : ∀ (x : α) (l : List α) , (insertOrd x l).eval (sortModel α) = insertOrdNaive x l := by @@ -214,6 +219,11 @@ lemma insertOrd_is_insertOrdNaive [LinearOrder α] : exact ih · simp +lemma insertOrd_length [LinearOrder α] (x : α) (l : List α) : + ((insertOrd x l).eval (sortModel α)).length = l.length + 1 := by + rw [insertOrd_is_insertOrdNaive] + simp [insertOrdNaive_length] + lemma hbind_compares [LinearOrder α] : (Prog.time (FreeM.bind (insertOrd x tail) From 03bdd091855680bade94816c1a45ab91daa20c7d Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Feb 2026 01:37:28 +0100 Subject: [PATCH 068/176] Remove #checks --- Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean | 3 --- 1 file changed, 3 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index be87044e1..2dc7057b6 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -17,9 +17,6 @@ namespace Algorithms open Prog -#check insertOrd -#check List.foldr - def insertionSort (l : List α) : Prog (SortOps α) (List α) := match l with | [] => return [] From f530a75f74f9040142972f35b5e9150dddc2d19b Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Feb 2026 03:22:38 +0100 Subject: [PATCH 069/176] Clean up merge sort --- .../Algorithms/MergeSort.lean | 231 ++++++++++++------ 1 file changed, 158 insertions(+), 73 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 9a51c28ce..6dd29ea1a 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -10,27 +10,8 @@ public import Cslib.AlgorithmsTheory.QueryModel @[expose] public section -/-! -# Merge sort in the query model - -This file implements merge sort as a program in the query model defined in -`Cslib.Algorithms.QueryModel`. We use a two model approach to demonstrate the -wonders of reducing between models. - -## Main definitions - -- `merge` : merge step using `Prog` comparisons -- `split` : split a list in two by alternating elements -- `mergeSort` : merge sort expressed in the query model - -We also provide simple example evaluations of `mergeSort` and its time cost. --/ - - - namespace Cslib.Algorithms - inductive SortOps (α : Type) : Type → Type where | cmpLT (x : α) (y : α): SortOps α Bool | insertHead (l : List α) (x : α) : SortOps α (List α) @@ -66,6 +47,11 @@ def mergeNaive [LinearOrder α] (x y : List α) : List α := let rest := mergeNaive (x :: xs') ys' y :: rest +lemma mergeNaive_length [LinearOrder α] (x y : List α) : + (mergeNaive x y).length = x.length + y.length := by + fun_induction mergeNaive <;> try grind + + /-- Merge two sorted lists using comparisons in the query monad. -/ @[simp, grind] def merge (x y : List α) : Prog (SortOps α) (List α) := do @@ -81,17 +67,53 @@ def merge (x y : List α) : Prog (SortOps α) (List α) := do let rest ← merge (x :: xs') ys' return (y :: rest) +lemma merge_bind_pure_insert_x [LinearOrder α] (x y : α) (xs ys : List α) : + (Prog.time + (FreeM.bind (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest))) (sortModel α)) + = (merge xs (y :: ys)).time (sortModel α) := by + have h := Prog.time.bind (sortModel α) (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest)) + have h' : Prog.time (FreeM.bind (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest))) + (sortModel α) + 1 = (merge xs (y :: ys)).time (sortModel α) + 1 := by + simpa [PureCost.pureCost] using h + exact Nat.add_right_cancel h' + +lemma merge_bind_pure_insert_y [LinearOrder α] (x y : α) (xs ys : List α) : + (Prog.time + (FreeM.bind (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest))) (sortModel α)) + = (merge (x :: xs) ys).time (sortModel α) := by + have h := Prog.time.bind (sortModel α) (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest)) + have h' : Prog.time (FreeM.bind (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest))) + (sortModel α) + 1 = (merge (x :: xs) ys).time (sortModel α) + 1 := by + simpa [PureCost.pureCost] using h + exact Nat.add_right_cancel h' + lemma merge_timeComplexity [LinearOrder α] (x y : List α) : - (merge x y).time (sortModel α) = 1 + min x.length y.length := by + (merge x y).time (sortModel α) ≤ x.length + y.length + 1:= by fun_induction merge - · simp [PureCosts.pureCost] - · simp [PureCosts.pureCost] + · simp [PureCost.pureCost] + · simp [PureCost.pureCost] · expose_names - simp + simp only [bind, FreeM.lift_def, pure, FreeM.liftBind_bind, FreeM.pure_bind, sortModel, + Bool.if_false_right, Bool.and_true, Prog.time.eq_2, decide_eq_true_eq, List.length_cons] split_ifs with hxy - · simp [time, PureCosts.pureCost] - done - · done + · have hbind := merge_bind_pure_insert_x x y xs' ys' + simp only [sortModel, Bool.if_false_right, Bool.and_true] at hbind + rw [hbind] + have hih : + (merge xs' (y :: ys')).time (sortModel α) ≤ + xs'.length + (y :: ys').length + 1 := by + simpa using ih2 + have h := Nat.add_le_add_left hih 1 + simpa [List.length_cons, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using h + · have hbind := merge_bind_pure_insert_y x y xs' ys' + simp only [sortModel, Bool.if_false_right, Bool.and_true] at hbind + rw [hbind] + have hih : + (merge (x :: xs') ys').time (sortModel α) ≤ + (x :: xs').length + ys'.length + 1 := by + simpa using ih1 + have h := Nat.add_le_add_left hih 1 + simpa [List.length_cons, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using h lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : @@ -115,42 +137,18 @@ lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : simp_all only [not_lt, Prog.eval, pure, sortModel, Bool.if_false_right, Bool.and_true, rest] split - next h_1 => - simp_all only [FreeM.liftM_bind, bind, FreeM.liftM_pure, pure, List.cons.injEq] + · simp_all only [FreeM.liftM_bind, bind, FreeM.liftM_pure, pure, List.cons.injEq] apply And.intro · grind · grind - next - h_1 => - simp_all only [not_lt, FreeM.liftM_bind, bind, FreeM.liftM_pure, pure, List.cons.injEq, + · simp_all only [not_lt, FreeM.liftM_bind, bind, FreeM.liftM_pure, pure, List.cons.injEq, true_and] exact ih1 - - - --- /-- Split a list into two lists by alternating elements. -/ --- def split (xs : List Nat) : List Nat × List Nat := --- let rec go : List Nat → List Nat → List Nat → List Nat × List Nat --- | [], accL, accR => (accL.reverse, accR.reverse) --- | [x], accL, accR => ((x :: accL).reverse, accR.reverse) --- | x :: y :: xs, accL, accR => go xs (x :: accL) (y :: accR) --- go xs [] [] - --- /-- Merge sort expressed as a program in the query model. --- TODO: Working version without partial -/ --- partial def mergeSort : List Nat → Prog (SortOps Nat) (List Nat) --- | [] => pure [] --- | [x] => pure [x] --- | xs => --- let (left, right) := split xs --- do --- let sortedLeft ← mergeSort left --- let sortedRight ← mergeSort right --- merge sortedLeft sortedRight - --- #eval (mergeSort [5,3,8,6,2,7,4,1]).eval (sortModel Nat) --- #eval (mergeSort [5,3,8,6,2,7,4,1]).time (sortModel Nat) +lemma merge_length [LinearOrder α] (x y : List α) : + ((merge x y).eval (sortModel α)).length = x.length + y.length := by + rw [merge_is_mergeNaive] + apply mergeNaive_length def mergeSort (xs : List α) : Prog (SortOps α) (List α) := do if xs.length < 2 then return xs @@ -171,23 +169,110 @@ def mergeSortNaive [LinearOrder α] (xs : List α) : List α := lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : (mergeSort xs).eval (sortModel α) = mergeSortNaive xs := by - unfold mergeSortNaive - induction xs.length using Nat.strong_induction_on with - | h n ih => - unfold mergeSort - split_ifs with hxs_len - · simp [Id.run] - · simp [Id.run] - specialize ih (n / 2) (by grind) - split_ifs at ih with h_ih_if - · rw [←ih] - unfold mergeSort - simp_rw [←merge_is_mergeNaive] - done - · done - · simp [Id.run] - done - · done + classical + let P : Nat → Prop := + fun n => ∀ xs, xs.length = n → (mergeSort xs).eval (sortModel α) = mergeSortNaive xs + have hP : P xs.length := by + refine Nat.strong_induction_on (n := xs.length) ?_ + intro n ih xs hlen + by_cases hlt : xs.length < 2 + · nth_rewrite 1 [mergeSort] + nth_rewrite 1 [mergeSortNaive] + simp [hlt, Prog.eval, Id.run] + · have hge : 2 ≤ xs.length := by + exact le_of_not_gt hlt + have hpos : 0 < xs.length := by + exact lt_of_lt_of_le (by decide : 0 < (2 : Nat)) hge + set half : Nat := xs.length / 2 + set left : List α := xs.take half + set right : List α := xs.drop half + have hhalf_lt : half < xs.length := by + have h2 : 1 < (2 : Nat) := by decide + simpa [half] using (Nat.div_lt_self hpos h2) + have hleft_le : left.length ≤ half := by + simp [left, List.length_take] + have hleft_lt_len : left.length < xs.length := + lt_of_le_of_lt hleft_le hhalf_lt + have hright_lt_len : right.length < xs.length := by + have hhalf_pos : 0 < half := by + have h2 : 0 < (2 : Nat) := by decide + simpa [half] using (Nat.div_pos hge h2) + have hsub : xs.length - half < xs.length := Nat.sub_lt hpos hhalf_pos + simpa [right, List.length_drop, half] using hsub + have hleft : + (mergeSort left).eval (sortModel α) = mergeSortNaive left := + (ih left.length (by simpa [hlen] using hleft_lt_len)) left rfl + have hright : + (mergeSort right).eval (sortModel α) = mergeSortNaive right := + (ih right.length (by simpa [hlen] using hright_lt_len)) right rfl + have hleft' : + FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) + (mergeSort (xs.take (xs.length / 2))) = + mergeSortNaive (xs.take (xs.length / 2)) := by + simpa [left, half, Prog.eval, Id.run] using hleft + have hright' : + FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) + (mergeSort (xs.drop (xs.length / 2))) = + mergeSortNaive (xs.drop (xs.length / 2)) := by + simpa [right, half, Prog.eval, Id.run] using hright + have hmerge (a b : List α) : + FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) (merge a b) = + mergeNaive a b := by + simpa [Prog.eval, Id.run] using (merge_is_mergeNaive (α := α) a b) + nth_rewrite 1 [mergeSort] + nth_rewrite 1 [mergeSortNaive] + simp only [hlt, if_false, Prog.eval, Id.run, bind, pure, FreeM.liftM_bind] + set a := + FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) + (mergeSort (List.take (xs.length / 2) xs)) + set b := + FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) + (mergeSort (List.drop (xs.length / 2) xs)) + calc + FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) + (merge + (FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) + (mergeSort (List.take (xs.length / 2) xs))) + (FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) + (mergeSort (List.drop (xs.length / 2) xs)))) = + FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) (merge a b) := by + simp [a, b] + _ = mergeNaive a b := hmerge a b + _ = mergeNaive (mergeSortNaive (List.take (xs.length / 2) xs)) + (mergeSortNaive (List.drop (xs.length / 2) xs)) := by + simp only [a, b, hleft', hright'] + exact hP xs rfl + + +lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : + (mergeSortNaive xs).length = xs.length := by + by_cases h₂ : xs.length < 2 + · unfold mergeSortNaive + simp [h₂] + · unfold mergeSortNaive + simp only [h₂, ↓reduceIte] + induction h : xs.length using Nat.strong_induction_on generalizing xs with + | h n ih => + rw [mergeNaive_length] + have h₁ := ih ((List.take (n / 2) xs)).length (by simp [List.length_take]; grind) + have h₂ := ih ((List.drop (n / 2) xs)).length (by simp [List.length_drop]; grind) + specialize h₁ (List.take (n / 2) xs) + specialize h₂ (List.drop (n / 2) xs) + + by_cases hdrop : (List.drop (n / 2) xs).length < 2 + <;> by_cases htake : (List.take (n / 2) xs).length < 2 + · simp_all + done + · done + · done + · specialize h₁ htake rfl + done + + done +lemma mergeSort_length [LinearOrder α] (xs : List α) : + ((mergeSort xs).eval (sortModel α)).length = xs.length := by + rw [mergeSort_is_mergeSortNaive] + apply mergeNaive_length lemma mergeNaive_sorted_sorted [LinearOrder α] (xs ys : List α) From 9ff1ebcb8703009f628a760a7f7d0dc145582516 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Feb 2026 03:23:08 +0100 Subject: [PATCH 070/176] Clean up merge sort --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 6dd29ea1a..c05d1d782 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -265,14 +265,13 @@ lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : done · done · done - · specialize h₁ htake rfl + · specialize h₁ htake rfl done - done lemma mergeSort_length [LinearOrder α] (xs : List α) : ((mergeSort xs).eval (sortModel α)).length = xs.length := by rw [mergeSort_is_mergeSortNaive] - apply mergeNaive_length + apply mergeSortNaive_length lemma mergeNaive_sorted_sorted [LinearOrder α] (xs ys : List α) From a36cf0617ba175c65e8edbe1fb5143c80f5edcf3 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Feb 2026 03:24:04 +0100 Subject: [PATCH 071/176] More work to be done --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index c05d1d782..f1e43b09f 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -258,10 +258,9 @@ lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : have h₂ := ih ((List.drop (n / 2) xs)).length (by simp [List.length_drop]; grind) specialize h₁ (List.take (n / 2) xs) specialize h₂ (List.drop (n / 2) xs) - by_cases hdrop : (List.drop (n / 2) xs).length < 2 <;> by_cases htake : (List.take (n / 2) xs).length < 2 - · simp_all + · done · done · done From fbb8f3050d26f0bf3e8e688c17fe1c96615b2b6f Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 18 Feb 2026 03:34:43 +0100 Subject: [PATCH 072/176] More work to be done --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index f1e43b09f..4585ff102 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -138,7 +138,7 @@ lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : Bool.if_false_right, Bool.and_true, rest] split · simp_all only [FreeM.liftM_bind, bind, FreeM.liftM_pure, pure, List.cons.injEq] - apply And.intro + refine ⟨?_, ?_⟩ · grind · grind · simp_all only [not_lt, FreeM.liftM_bind, bind, FreeM.liftM_pure, pure, List.cons.injEq, From 1e67a97b6190886e8b1da361ec561526de90b6d3 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 03:54:06 +0100 Subject: [PATCH 073/176] Simplify this PR. Use AddCommMonoid for now --- .../Algorithms/ListInsertionSort.lean | 65 ++---- .../Algorithms/ListLinearSearch.lean | 58 ++--- .../Algorithms/ListOrderedInsert.lean | 212 ++++++++--------- .../Algorithms/MergeSort.lean | 46 ++-- .../Lean/MergeSort/MergeSort.lean | 218 ------------------ Cslib/AlgorithmsTheory/Lean/TimeM.lean | 109 --------- Cslib/AlgorithmsTheory/QueryModel.lean | 54 ++--- .../StandardModels/ParametricWordRAM.lean | 0 graph.png | Bin 0 -> 64547 bytes import_graph.dot | 16 ++ 10 files changed, 179 insertions(+), 599 deletions(-) delete mode 100644 Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean delete mode 100644 Cslib/AlgorithmsTheory/Lean/TimeM.lean delete mode 100644 Cslib/AlgorithmsTheory/StandardModels/ParametricWordRAM.lean create mode 100644 graph.png create mode 100644 import_graph.dot diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index 2dc7057b6..b0ee6f898 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -28,11 +28,10 @@ theorem insertionSort_sorted [LinearOrder α] (l : List α) : ((insertionSort l).eval (sortModel α)).Pairwise (· ≤ ·) := by induction l with | nil => - simp [insertionSort, Id.run] + simp [insertionSort] | cons head tail ih => have h := insertOrd_Sorted ((insertionSort tail).eval (sortModel α)) head ih - simp only [eval, Id.run, pure, pcSortOps.eq_1, sortModel, Bool.if_false_right, Bool.and_true, - insertionSort, bind, FreeM.liftM_bind] + simp only [eval, insertionSort, bind, FreeM.liftM_bind] exact h lemma insertionSort_time_compares [LinearOrder α] (head : α) (tail : List α) : @@ -41,9 +40,7 @@ lemma insertionSort_time_compares [LinearOrder α] (head : α) (tail : List α) ((insertOrd head ((insertionSort tail).eval (sortModel α))).time (sortModel α)).compares := by have h := congrArg SortOpsCost.compares (Prog.time.bind (M := sortModel α) (insertionSort tail) (fun rest => insertOrd head rest)) - simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, PureCost.pureCost, - SortModel_add_compares] at h - simp only [Add.add, Int.add_def, add_zero] at h + simp only [HAdd.hAdd, acsSortOpsCost, Add.add] at h simpa [insertionSort] using h lemma insertionSort_time_inserts [LinearOrder α] (head : α) (tail : List α) : @@ -52,58 +49,40 @@ lemma insertionSort_time_inserts [LinearOrder α] (head : α) (tail : List α) : ((insertOrd head ((insertionSort tail).eval (sortModel α))).time (sortModel α)).inserts := by have h := congrArg SortOpsCost.inserts (Prog.time.bind (M := sortModel α) (insertionSort tail) (fun rest => insertOrd head rest)) - simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, PureCost.pureCost, - SortModel_add_inserts] at h - simp only [Add.add, Int.add_def, add_zero] at h - simpa [insertionSort] using h - -lemma insertionSort_time_pure [LinearOrder α] (head : α) (tail : List α) : - ((insertionSort (head :: tail)).time (sortModel α)).pure + 1 = - ((insertionSort tail).time (sortModel α)).pure + - ((insertOrd head ((insertionSort tail).eval (sortModel α))).time (sortModel α)).pure := by - have h := congrArg SortOpsCost.pure - (Prog.time.bind (M := sortModel α) (insertionSort tail) (fun rest => insertOrd head rest)) - simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, PureCost.pureCost, - SortModel_add_pure] at h - simp only [Add.add, Int.add_def] at h + simp only [HAdd.hAdd, acsSortOpsCost, Add.add] at h simpa [insertionSort] using h lemma insertionSort_length [LinearOrder α] (l : List α) : ((insertionSort l).eval (sortModel α)).length = l.length := by induction l with | nil => - simp [insertionSort, Prog.eval, Id.run] + simp [insertionSort] | cons head tail ih => have h := insertOrd_length (x := head) ((insertionSort tail).eval (sortModel α)) - simp [Prog.eval, Id.run] at ih - simpa [insertionSort, Prog.eval, Id.run, bind, FreeM.liftM_bind, ih] using h + simp only [eval] at ih + simpa [insertionSort, ih] using h theorem insertionSort_complexity [LinearOrder α] (l : List α) : ((insertionSort l).time (sortModel α)) - ≤ ⟨l.length * (l.length + 1), (l.length + 1) * (l.length + 2), 1 + l.length⟩ := by + ≤ ⟨l.length * (l.length + 1), (l.length + 1) * (l.length + 2)⟩ := by induction l with | nil => - simp [insertionSort] + simp only [partialOrderSortOps, not_and, not_le, insertionSort, FreeM.pure_eq_pure, sortModel, + Bool.if_false_right, Bool.and_true, time.eq_1, List.length_nil, zero_add, mul_one, one_mul, + nonpos_iff_eq_zero] + tauto | cons head tail ih => have h := insertOrd_complexity_upper_bound ((insertionSort tail).eval (sortModel α)) head - simp_all only [partialOrderSortOps, not_and, not_le, pcSortOps.eq_1, List.length_cons, - Nat.cast_add, Nat.cast_one, insertionSort_length] - obtain ⟨ih₁,ih₂,ih₃⟩ := ih - obtain ⟨h₁,h₂,h₃⟩ := h - refine ⟨?_, ?_, ?_⟩ - · clear h₂ h₃ - rw [insertionSort_time_compares (head := head) (tail := tail)] - have h_nonneg : (0 : ℤ) ≤ (tail.length : ℤ) := by - exact Int.natCast_nonneg _ - nlinarith [ih₁, h₁, h_nonneg] - · clear h₁ h₃ - rw [insertionSort_time_inserts (head := head) (tail := tail)] - have h_nonneg : (0 : ℤ) ≤ (tail.length : ℤ) := by - exact Int.natCast_nonneg _ - nlinarith [ih₂, h₂, h_nonneg] - · clear h₁ h₂ - have hp := insertionSort_time_pure (head := head) (tail := tail) - nlinarith [ih₃, h₃, hp] + simp_all only [partialOrderSortOps, not_and, not_le, List.length_cons, insertionSort_length] + 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 diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index cb536b759..f9c37b944 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -30,35 +30,6 @@ def ListSearch_Nat [DecidableEq α] : Model (ListSearch α) ℕ where match q with | .compare _ _ => 1 -structure CmpCount where - cmp : ℕ - pure : ℕ - -instance cmpCountAdd : Add (CmpCount) where - add x y := ⟨x.1 + y.1, x.2 + y.2⟩ - -instance : Zero (CmpCount) where - zero := ⟨0,0⟩ - -instance : PureCost (CmpCount) where - pureCost := ⟨0,1⟩ - -instance : AddCommSemigroup (CmpCount) where - add_assoc a b c := by - simp [HAdd.hAdd] - simp [cmpCountAdd, instAddNat, Nat.add_assoc] - add_comm a b := by - simp [HAdd.hAdd] - simp [cmpCountAdd, instAddNat, Nat.add_comm] - -def ListSearch_Cmp [DecidableEq α] : Model (ListSearch α) CmpCount where - evalQuery q := - match q with - | .compare l x => l.head? == some x - cost q := - match q with - | .compare _ _ => ⟨1,0⟩ - open ListSearch in def listLinearSearch (l : List α) (x : α) : Prog (ListSearch α) Bool := do match l with @@ -77,22 +48,26 @@ lemma listLinearSearchM_correct_true [iDec : DecidableEq α] (l : List α) : | nil => simp_all only [List.not_mem_nil] | cons head tail ih => - simp_all only [List.mem_cons, listLinearSearch, bind, FreeM.lift_def, pure, - FreeM.liftBind_bind, FreeM.pure_bind, eval, FreeM.liftM, Id.run] + simp_all only [eval, List.mem_cons, listLinearSearch, FreeM.lift_def, FreeM.pure_eq_pure, + FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, pure_bind] split_ifs with h - · simp · obtain (x_head | xtail) := x_mem_l · rw [x_head] at h - simp[ListSearch_Nat] at h + simp only [ListSearch_Nat, List.head?_cons, decide_true] at h + simp · specialize ih xtail - exact ih - + simp + · obtain (x_head | x_tail) := x_mem_l + · rw [x_head] at h + simp [ListSearch_Nat, List.head?_cons, decide_true] at h + · specialize ih x_tail + simp_all lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) : ∀ x : α, x ∉ l → (listLinearSearch l x).eval ListSearch_Nat = false := by intro x x_mem_l induction l with | nil => - simp_all [listLinearSearch, eval, Id.run] + simp_all [listLinearSearch, eval] | cons head tail ih => simp only [List.mem_cons, not_or] at x_mem_l specialize ih x_mem_l.2 @@ -111,18 +86,19 @@ lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List intro x induction l with | nil => - simp_all [listLinearSearch, ListSearch_Nat, time, PureCost.pureCost] - | cons head tail ih => simp_all [listLinearSearch, ListSearch_Nat, time] + | cons head tail ih => + simp_all [listLinearSearch, ListSearch_Nat] split_ifs with h_head - · simp [time, PureCost.pureCost] + · simp [time] · grind lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Nontrivial α] : - ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = 1 + l.length := by + ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = l.length := by obtain ⟨x, y, x_neq_y⟩ := inon use [x,x,x,x,x,y], y - simp_all [time, ListSearch_Nat, listLinearSearch, PureCost.pureCost] + simp_all [ListSearch_Nat, listLinearSearch] + end Algorithms end Cslib diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index a8ebe6571..c301cb092 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -27,58 +27,69 @@ open SortOps @[ext, grind] structure SortOpsCost where - compares : ℤ - inserts : ℤ - pure : ℤ + compares : ℕ + inserts : ℕ -@[simp, grind] -instance pcSortOps : PureCost SortOpsCost where - pureCost := ⟨0,0,1⟩ @[simp, grind] -instance zeroSortOps : Zero SortOpsCost := ⟨0,0,0⟩ +instance zeroSortOps : Zero SortOpsCost := ⟨0,0⟩ @[simp] instance partialOrderSortOps : PartialOrder SortOpsCost where - le | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ ∧ p₁ ≤ p₂ + le | ⟨c₁, i₁⟩, ⟨c₂, i₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ le_refl := by intro c simp only [le_refl, and_self] le_trans a b c := by simp only [and_imp] - intro ab_comps ab_inserts ab_pures bc_comps bc_inserts bc_pures - refine ⟨?_, ?_, ?_⟩ - all_goals solve_by_elim [Int.le_trans] + intro ab_comps ab_inserts bc_comps bc_inserts + refine ⟨?_, ?_⟩ + all_goals solve_by_elim [Nat.le_trans] le_antisymm := by - intro ⟨a_comps, a_inserts, a_pures⟩ ⟨b_comps, b_inserts, b_pures⟩ + intro ⟨a_comps, a_inserts⟩ ⟨b_comps, b_inserts⟩ simp only [SortOpsCost.mk.injEq, and_imp] - intro ab_comps ab_inserts ab_pures ba_comps ba_inserts ba_pures - refine ⟨?_, ?_, ?_⟩ - all_goals solve_by_elim[Int.le_antisymm] + intro ab_comps ab_inserts ba_comps ba_inserts + refine ⟨?_, ?_⟩ + all_goals solve_by_elim[Nat.le_antisymm] def add : SortOpsCost → SortOpsCost → SortOpsCost - | ⟨c₁, i₁, p₁⟩, ⟨c₂, i₂, p₂⟩ => ⟨c₁ + c₂, i₁ + i₂, p₁ + p₂⟩ + | ⟨c₁, i₁⟩, ⟨c₂, i₂⟩ => ⟨c₁ + c₂, i₁ + i₂⟩ + +def nsmul : ℕ → SortOpsCost → SortOpsCost + | n, ⟨c, i⟩ => ⟨n • c, n • i⟩ -def nsmul (n : ℕ) (x : SortOpsCost) : SortOpsCost := - match n with - | 0 => 0 - | m + 1 => add x (nsmul m x) -instance acsSortOpsCost : AddCommSemigroup SortOpsCost where +instance acsSortOpsCost : AddCommMonoid SortOpsCost where add := add add_assoc := by intro a b c - simp [HAdd.hAdd] - simp [add, Int.instAdd, Int.add_assoc] + simp only [HAdd.hAdd] + simp [add, instAddNat, Nat.add_assoc] add_comm := by intro a b - simp [HAdd.hAdd] - simp [add, Int.instAdd, Int.add_comm] - + simp only [HAdd.hAdd] + simp [add, instAddNat, Nat.add_comm] + zero_add := by + intro ⟨c, i⟩ + simp only [HAdd.hAdd, add] + simp [instAddNat] + add_zero := by + intro ⟨c, i⟩ + simp only [HAdd.hAdd, add] + simp [instAddNat] + nsmul := nsmul + nsmul_zero := by + intro x + rw [nsmul, zero_nsmul, zero_nsmul] + rfl + + nsmul_succ := by + intro n x + rw [nsmul, succ_nsmul, succ_nsmul] + rfl -@[simp, grind] def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where evalQuery q := match q with @@ -90,8 +101,8 @@ def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost wher | .insertHead l x => x :: l cost q := match q with - | .cmpLT _ _ => ⟨1,0,0⟩ - | .insertHead _ _ => ⟨0,1,0⟩ + | .cmpLT _ _ => ⟨1,0⟩ + | .insertHead _ _ => ⟨0,1⟩ @[grind =] lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : @@ -107,10 +118,8 @@ lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : lemma SortModel_addComponents (m₁ m₂ m₃ : SortOpsCost) : m₁ + m₂ = m₃ ↔ m₁.compares + m₂.compares = m₃.compares ∧ - m₁.inserts + m₂.inserts = m₃.inserts ∧ - m₁.pure + m₂.pure = m₃.pure := by - simp only [HAdd.hAdd] - simp only [Int.instAdd] + m₁.inserts + m₂.inserts = m₃.inserts := by + simp only [HAdd.hAdd, instAddNat] aesop @[simp] @@ -123,16 +132,10 @@ lemma SortModel_add_inserts (m₁ m₂ : SortOpsCost) : (Add.add m₁ m₂).inserts = m₁.inserts + m₂.inserts := by cases m₁; cases m₂; rfl -@[simp] -lemma SortModel_add_pure (m₁ m₂ : SortOpsCost) : - (Add.add m₁ m₂).pure = m₁.pure + m₂.pure := by - cases m₁; cases m₂; rfl - lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : m₁ ≤ m₂ ↔ m₁.compares ≤ m₂.compares ∧ - m₁.inserts ≤ m₂.inserts ∧ - m₁.pure ≤ m₂.pure := by + m₁.inserts ≤ m₂.inserts := by simp only [LE.le] @@ -208,23 +211,24 @@ lemma insertOrd_is_insertOrdNaive [LinearOrder α] : intro x l induction l with | nil => - simp_all [insertOrd, insertOrdNaive, Id.run] + simp_all [insertOrd, insertOrdNaive, sortModel] | cons head tail ih => - simp_all only [Prog.eval, Id.run, pure, sortModel, - Bool.if_false_right, Bool.and_true, insertOrd, bind, FreeM.lift_def, FreeM.liftBind_bind, - FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq, insertOrdNaive] + simp_all only [eval, sortModel, Bool.if_false_right, Bool.and_true, insertOrd, bind, + FreeM.lift_def, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, insertOrdNaive] split_ifs with h_head - · simp only [FreeM.liftM_bind, bind, FreeM.liftM_liftBind, FreeM.liftM_pure, pure, - List.cons.injEq, true_and] + · simp only [FreeM.liftM_bind, FreeM.liftM_liftBind, FreeM.liftM_pure, bind_pure, + bind_pure_comp, Id.run_map, List.cons.injEq, true_and] exact ih - · simp + · simp_all only [decide_false, reduceCtorEq] + · simp_all + · simp_all lemma insertOrd_length [LinearOrder α] (x : α) (l : List α) : ((insertOrd x l).eval (sortModel α)).length = l.length + 1 := by rw [insertOrd_is_insertOrdNaive] simp [insertOrdNaive_length] -lemma hbind_compares [LinearOrder α] : +lemma bind_compares {α} (x tail head) [LinearOrder α] : (Prog.time (FreeM.bind (insertOrd x tail) (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) @@ -234,12 +238,14 @@ lemma hbind_compares [LinearOrder α] : (Prog.time.bind (M := sortModel α) (op := insertOrd x tail) (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) - simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, bind, sortModel, Bool.if_false_right, - Bool.and_true, PureCost.pureCost, SortModel_add_compares, time, eval, pure] at h - simp only [Add.add, Int.add_def, add_zero] at h - exact h + simp only [acsSortOpsCost, zeroSortOps, FreeM.bind_eq_bind, sortModel, Bool.if_false_right, + Bool.and_true, HAdd.hAdd, time, eval, SortModel_add_compares] at h + simp only [Add.add] at h + simp_all only [sortModel, Bool.if_false_right, Bool.and_true] + rfl + -lemma hbind_inserts [LinearOrder α] : +lemma bind_inserts {α} (x tail head) [LinearOrder α] : (Prog.time (FreeM.bind (insertOrd x tail) (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) @@ -249,82 +255,50 @@ lemma hbind_inserts [LinearOrder α] : (Prog.time.bind (M := sortModel α) (op := insertOrd x tail) (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) - simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, bind, sortModel, Bool.if_false_right, - Bool.and_true, PureCost.pureCost, SortModel_add_inserts, time, eval, pure] at h - simp only [Add.add, Int.add_def, add_zero] at h + simp only [HAdd.hAdd, acsSortOpsCost, bind, sortModel, Bool.if_false_right, + Bool.and_true, SortModel_add_inserts, time, eval] at h + simp only [Add.add] at h exact h -lemma hbind_pure [LinearOrder α] : - (Prog.time - (FreeM.bind (insertOrd x tail) - (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) - (sortModel α)).pure = - (Prog.time (insertOrd x tail) (sortModel α)).pure := by - have h := congrArg SortOpsCost.pure - (Prog.time.bind (M := sortModel α) - (op := insertOrd x tail) - (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) - simp only [HAdd.hAdd, acsSortOpsCost, pcSortOps, bind, sortModel, Bool.if_false_right, - Bool.and_true, PureCost.pureCost, SortModel_add_pure, time, eval, pure] at h - simp only [Add.add, Int.add_def, zero_add, add_left_inj] at h - exact h +lemma cost_cmpLT_compares [LinearOrder α] : ((sortModel α).2 (cmpLT head x)).compares = 1 := by + simp [sortModel] + +lemma cost_cmpLT_inserts [LinearOrder α] + : ((sortModel α).2 (cmpLT head x)).inserts = 0 := by + simp [sortModel] + +lemma cost_insertHead_compares [LinearOrder α] + : ((sortModel α).2 (insertHead x l)).compares = 0 := by + simp [sortModel] +lemma cost_insertHead_inserts [LinearOrder α] + : ((sortModel α).2 (insertHead x l)).inserts = 1 := by + simp [sortModel] lemma insertOrd_complexity_upper_bound [LinearOrder α] : ∀ (l : List α) (x : α), - (insertOrd x l).time (sortModel α) ≤ ⟨l.length, l.length + 1, 1⟩ := by + (insertOrd x l).time (sortModel α) ≤ ⟨l.length, l.length + 1⟩ := by intro l x induction l with | nil => - simp_all [sortModel, insertOrd, Prog.time, PureCost.pureCost, - HAdd.hAdd] - simp [Add.add] + simp [insertOrd, sortModel] | cons head tail ih => - simp_all only [partialOrderSortOps, not_and, not_le, pcSortOps, sortModel, - Bool.if_false_right, Bool.and_true, insertOrd, bind, FreeM.lift_def, FreeM.liftBind_bind, - FreeM.pure_bind, time, decide_eq_true_eq, List.length_cons, Nat.cast_add, Nat.cast_one] + simp_all only [partialOrderSortOps, not_and, not_le, insertOrd, FreeM.lift_def, + FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, time.eq_2, List.length_cons] + obtain ⟨ih_compares, ih_inserts⟩ := ih split_ifs with h_head - · obtain ⟨h₁,h₂, h₃⟩ := ih - refine ⟨?_, ?_, ?_⟩ - · clear h₂ h₃ - simp only [HAdd.hAdd, acsSortOpsCost, SortModel_add_compares] - change (Add.add 1 - (time (FreeM.bind (insertOrd x tail) fun res => - FreeM.liftBind (insertHead res head) FreeM.pure) (sortModel α)).compares ≤ - Add.add (↑tail.length) 1) - rw [hbind_compares] - simp [Add.add] - linarith [h₁] - · clear h₁ h₃ - simp only [HAdd.hAdd, acsSortOpsCost, SortModel_add_inserts] - change (Add.add 0 - (time (FreeM.bind (insertOrd x tail) fun res => - FreeM.liftBind (insertHead res head) FreeM.pure) (sortModel α)).inserts ≤ - Add.add (Add.add (↑tail.length) 1) 1) - rw [hbind_inserts] - simp [Add.add] - linarith [h₂] - · clear h₁ h₂ - simp only [HAdd.hAdd, acsSortOpsCost, SortModel_add_pure] - change (Add.add 0 - (time (FreeM.bind (insertOrd x tail) fun res => - FreeM.liftBind (insertHead res head) FreeM.pure) (sortModel α)).pure ≤ - 1) - rw [hbind_pure] - simpa [Add.add] using h₃ - · obtain ⟨h₁, h₂, h₃⟩ := ih - refine ⟨?_, ?_, ?_⟩ - · clear h₂ h₃ - simp [HAdd.hAdd, acsSortOpsCost, SortModel_add_compares] - simp [Add.add] - · clear h₁ h₃ - simp [HAdd.hAdd, acsSortOpsCost, SortModel_add_inserts] - simp [Add.add] - have h_nonneg : (0 : ℤ) ≤ (tail.length : ℤ) := by - exact Int.natCast_nonneg _ - linarith - · clear h₁ h₂ - simp [HAdd.hAdd, acsSortOpsCost, SortModel_add_pure] - simp [Add.add] + · simp only [HAdd.hAdd, Add.add, add, Nat.add] + simp only [Nat.add_eq, Nat.succ_eq_add_one] + constructor + · clear ih_inserts + rw [bind_compares, cost_cmpLT_compares] + grind + · clear ih_compares + rw [cost_cmpLT_inserts, bind_inserts] + grind + · simp only [HAdd.hAdd, Add.add, add, Nat.add, sortModel] + grind + + lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : l.Pairwise (· ≤ ·) → ((insertOrd x l).eval (sortModel α)).Pairwise (· ≤ ·) := by diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 4585ff102..5115751a0 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -18,7 +18,7 @@ inductive SortOps (α : Type) : Type → Type where open SortOps -@[simp, grind] + def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where evalQuery q := match q with @@ -33,7 +33,12 @@ def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where | .cmpLT _ _ => 1 | .insertHead _ _ => 1 - +@[simp] +lemma sortModel_eval_1 [LinearOrder α] (y x : α) : + y ≤ x → (sortModel α).evalQuery (cmpLT x y) = false := by + intro h + simp only [sortModel, Bool.if_false_right, Bool.and_true, decide_eq_false_iff_not, not_lt] + exact h /-- Merge two sorted lists using comparisons in the query monad. -/ def mergeNaive [LinearOrder α] (x y : List α) : List α := match x,y with @@ -74,7 +79,7 @@ lemma merge_bind_pure_insert_x [LinearOrder α] (x y : α) (xs ys : List α) : have h := Prog.time.bind (sortModel α) (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest)) have h' : Prog.time (FreeM.bind (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest))) (sortModel α) + 1 = (merge xs (y :: ys)).time (sortModel α) + 1 := by - simpa [PureCost.pureCost] using h + simpa using h exact Nat.add_right_cancel h' lemma merge_bind_pure_insert_y [LinearOrder α] (x y : α) (xs ys : List α) : @@ -84,14 +89,14 @@ lemma merge_bind_pure_insert_y [LinearOrder α] (x y : α) (xs ys : List α) : have h := Prog.time.bind (sortModel α) (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest)) have h' : Prog.time (FreeM.bind (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest))) (sortModel α) + 1 = (merge (x :: xs) ys).time (sortModel α) + 1 := by - simpa [PureCost.pureCost] using h + simpa using h exact Nat.add_right_cancel h' lemma merge_timeComplexity [LinearOrder α] (x y : List α) : (merge x y).time (sortModel α) ≤ x.length + y.length + 1:= by fun_induction merge - · simp [PureCost.pureCost] - · simp [PureCost.pureCost] + · simp + · simp · expose_names simp only [bind, FreeM.lift_def, pure, FreeM.liftBind_bind, FreeM.pure_bind, sortModel, Bool.if_false_right, Bool.and_true, Prog.time.eq_2, decide_eq_true_eq, List.length_cons] @@ -119,31 +124,12 @@ lemma merge_timeComplexity [LinearOrder α] (x y : List α) : lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : (merge x y).eval (sortModel α) = mergeNaive x y := by fun_induction mergeNaive - · simp [merge, Id.run] + · simp [merge] + · simp [merge] · expose_names - simp [Id.run] + simp_all [Prog.eval, merge, rest, sortModel] · expose_names - simp only [Prog.eval, Id.run, pure, sortModel, - Bool.if_false_right, Bool.and_true, merge, bind, FreeM.lift_def, FreeM.liftBind_bind, - FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq] - simp_all only [Prog.eval, pure, sortModel, - Bool.if_false_right, Bool.and_true, ↓reduceIte, FreeM.liftM_bind, bind, - FreeM.liftM_pure, List.cons.injEq, true_and, rest] - exact ih1 - · simp only [Prog.eval, Id.run, pure, sortModel, - Bool.if_false_right, Bool.and_true, merge, bind, FreeM.lift_def, FreeM.liftBind_bind, - FreeM.pure_bind, FreeM.liftM_liftBind, decide_eq_true_eq] - rename_i rest ih1 - simp_all only [not_lt, Prog.eval, pure, sortModel, - Bool.if_false_right, Bool.and_true, rest] - split - · simp_all only [FreeM.liftM_bind, bind, FreeM.liftM_pure, pure, List.cons.injEq] - refine ⟨?_, ?_⟩ - · grind - · grind - · simp_all only [not_lt, FreeM.liftM_bind, bind, FreeM.liftM_pure, pure, List.cons.injEq, - true_and] - exact ih1 + simp_all [Prog.eval, merge, rest] lemma merge_length [LinearOrder α] (x y : List α) : ((merge x y).eval (sortModel α)).length = x.length + y.length := by @@ -178,7 +164,7 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : by_cases hlt : xs.length < 2 · nth_rewrite 1 [mergeSort] nth_rewrite 1 [mergeSortNaive] - simp [hlt, Prog.eval, Id.run] + simp [hlt, Prog.eval] · have hge : 2 ≤ xs.length := by exact le_of_not_gt hlt have hpos : 0 < xs.length := by diff --git a/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean b/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean deleted file mode 100644 index 397cfe1e4..000000000 --- a/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean +++ /dev/null @@ -1,218 +0,0 @@ -/- -Copyright (c) 2025 Sorrachai Yingchareonthawornhcai. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Sorrachai Yingchareonthawornhcai --/ - -module - -public import Cslib.Init -public import Cslib.Algorithms.Lean.TimeM -public import Mathlib.Data.Nat.Cast.Order.Ring -public import Mathlib.Data.Nat.Lattice -public import Mathlib.Data.Nat.Log - -@[expose] public section - -/-! -# MergeSort on a list - -In this file we introduce `merge` and `mergeSort` algorithms that returns a time monad -over the list `TimeM (List α)`. The time complexity of `mergeSort` is the number of comparisons. - --- -## Main results - -- `mergeSort_correct`: `mergeSort` permutes the list into a sorted one. -- `mergeSort_time`: The number of comparisons of `mergeSort` is at most `n*⌈log₂ n⌉`. - --/ - -set_option autoImplicit false - -namespace Cslib.Algorithms.Lean.TimeM - -variable {α : Type} [LinearOrder α] - -/-- Merges two lists into a single list, counting comparisons as time cost. -Returns a `TimeM (List α)` where the time represents the number of comparisons performed. -/ -def merge : List α → List α → TimeM (List α) - | [], ys => return ys - | xs, [] => return xs - | x::xs', y::ys' => do - ✓ let c := (x ≤ y : Bool) - if c then - let rest ← merge xs' (y::ys') - return (x :: rest) - else - let rest ← merge (x::xs') ys' - return (y :: rest) - -/-- Sorts a list using the merge sort algorithm, counting comparisons as time cost. -Returns a `TimeM (List α)` where the time represents the total number of comparisons. -/ -def mergeSort (xs : List α) : TimeM (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 - -section Correctness - -open List - -/-- A list is sorted if it satisfies the `Pairwise (· ≤ ·)` predicate. -/ -abbrev IsSorted (l : List α) : Prop := List.Pairwise (· ≤ ·) l - -/-- `x` is a minimum element of list `l` if `x ≤ b` for all `b ∈ l`. -/ -abbrev MinOfList (x : α) (l : List α) : Prop := ∀ b ∈ l, x ≤ b - -@[grind →] -theorem mem_either_merge (xs ys : List α) (z : α) (hz : z ∈ ⟪merge xs ys⟫) : z ∈ xs ∨ z ∈ ys := by - fun_induction merge - · exact mem_reverseAux.mp hz - · left - exact hz - · grind - -theorem min_all_merge (x : α) (xs ys : List α) (hxs : MinOfList x xs) (hys : MinOfList x ys) : - MinOfList x ⟪merge xs ys⟫ := by - grind - -theorem sorted_merge {l1 l2 : List α} (hxs : IsSorted l1) (hys : IsSorted l2) : - IsSorted ⟪merge l1 l2⟫ := by - fun_induction merge l1 l2 with - | case3 => - grind [pairwise_cons] - | _ => simpa - -theorem mergeSort_sorted (xs : List α) : IsSorted ⟪mergeSort xs⟫ := by - fun_induction mergeSort xs with - | case1 x => - rcases x with _ | ⟨a, _ | ⟨b, rest⟩⟩ <;> grind - | case2 _ _ _ _ _ ih2 ih1 => exact sorted_merge ih2 ih1 - -lemma merge_perm (l₁ l₂ : List α) : ⟪merge l₁ l₂⟫ ~ l₁ ++ l₂ := by - fun_induction merge with - | case1 => simp - | case2 => simp - | case3 => - grind - -theorem mergeSort_perm (xs : List α) : ⟪mergeSort xs⟫ ~ xs := by - fun_induction mergeSort xs with - | case1 => simp - | case2 x _ _ left right ih2 ih1 => - simp only [ret_bind] - calc - ⟪merge ⟪mergeSort left⟫ ⟪mergeSort right⟫⟫ ~ - ⟪mergeSort left⟫ ++ ⟪mergeSort right⟫ := by apply merge_perm - _ ~ left++right := Perm.append ih2 ih1 - _ ~ x := by simp only [take_append_drop, Perm.refl, left, right] - -/-- MergeSort is functionally correct. -/ -theorem mergeSort_correct (xs : List α) : IsSorted ⟪mergeSort xs⟫ ∧ ⟪mergeSort xs⟫ ~ xs := - ⟨mergeSort_sorted xs, mergeSort_perm xs⟩ - -end Correctness - -section TimeComplexity - -/-- Recurrence relation for the time complexity of merge sort. -For a list of length `n`, this counts the total number of comparisons: -- Base cases: 0 comparisons for lists of length 0 or 1 -- Recursive case: split the list, sort both halves, - then merge (which takes at most `n` comparisons) -/ -def timeMergeSortRec : ℕ → ℕ -| 0 => 0 -| 1 => 0 -| n@(_+2) => timeMergeSortRec (n/2) + timeMergeSortRec ((n-1)/2 + 1) + n - -open Nat (clog) - -/-- Key Lemma: ⌈log2 ⌈n/2⌉⌉ ≤ ⌈log2 n⌉ - 1 for n > 1 -/ -@[grind →] -lemma clog2_half_le (n : ℕ) (h : n > 1) : clog 2 ((n + 1) / 2) ≤ clog 2 n - 1 := by - rw [Nat.clog_of_one_lt one_lt_two h] - grind - -/-- Same logic for the floor half: ⌈log2 ⌊n/2⌋⌉ ≤ ⌈log2 n⌉ - 1 -/ -@[grind →] -lemma clog2_floor_half_le (n : ℕ) (h : n > 1) : clog 2 (n / 2) ≤ clog 2 n - 1 := by - apply Nat.le_trans _ (clog2_half_le n h) - apply Nat.clog_monotone - grind - -private lemma some_algebra (n : ℕ) : - (n / 2 + 1) * clog 2 (n / 2 + 1) + ((n + 1) / 2 + 1) * clog 2 ((n + 1) / 2 + 1) + (n + 2) ≤ - (n + 2) * clog 2 (n + 2) := by - -- 1. Substitution: Let N = n_1 + 2 to clean up the expression - let N := n + 2 - have hN : N ≥ 2 := by omega - -- 2. Rewrite the terms using N - have t1 : n / 2 + 1 = N / 2 := by omega - have t2 : (n + 1) / 2 + 1 = (N + 1) / 2 := by omega - have t3 : n + 1 + 1 = N := by omega - let k := clog 2 N - have h_bound_l : clog 2 (N / 2) ≤ k - 1 := clog2_floor_half_le N hN - have h_bound_r : clog 2 ((N + 1) / 2) ≤ k - 1 := clog2_half_le N hN - have h_split : N / 2 + (N + 1) / 2 = N := by omega - grw [t1, t2, t3, h_bound_l, h_bound_r, ←Nat.add_mul, h_split] - exact Nat.le_refl (N * (k - 1) + N) - -/-- Upper bound function for merge sort time complexity: `T(n) = n * ⌈log₂ n⌉` -/ -abbrev T (n : ℕ) : ℕ := n * clog 2 n - -/-- Solve the recurrence -/ -theorem timeMergeSortRec_le (n : ℕ) : timeMergeSortRec n ≤ T n := by - fun_induction timeMergeSortRec with - | case1 => grind - | case2 => grind - | case3 n ih2 ih1 => - grw [ih1,ih2] - have := some_algebra n - grind [Nat.add_div_right] - -@[simp] theorem merge_ret_length_eq_sum (xs ys : List α) : - ⟪merge xs ys⟫.length = xs.length + ys.length := by - fun_induction merge with - | case3 => - grind - | _ => simp - -@[simp] theorem mergeSort_same_length (xs : List α) : - ⟪mergeSort xs⟫.length = xs.length := by - fun_induction mergeSort - · simp - · grind [merge_ret_length_eq_sum] - -@[simp] theorem merge_time (xs ys : List α) : (merge xs ys).time ≤ xs.length + ys.length := by - fun_induction merge with - | case3 => - grind - | _ => simp - -theorem mergeSort_time_le (xs : List α) : - (mergeSort xs).time ≤ timeMergeSortRec xs.length := by - fun_induction mergeSort with - | case1 => - grind - | case2 _ _ _ _ _ ih2 ih1 => - simp only [time_bind] - grw [merge_time] - simp only [mergeSort_same_length] - unfold timeMergeSortRec - grind - -/-- Time complexity of mergeSort -/ -theorem mergeSort_time (xs : List α) : - let n := xs.length - (mergeSort xs).time ≤ n * clog 2 n := by - grind [mergeSort_time_le, timeMergeSortRec_le] - -end TimeComplexity - -end Cslib.Algorithms.Lean.TimeM diff --git a/Cslib/AlgorithmsTheory/Lean/TimeM.lean b/Cslib/AlgorithmsTheory/Lean/TimeM.lean deleted file mode 100644 index d890bd9a1..000000000 --- a/Cslib/AlgorithmsTheory/Lean/TimeM.lean +++ /dev/null @@ -1,109 +0,0 @@ -/- -Copyright (c) 2025 Sorrachai Yingchareonthawornhcai. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Sorrachai Yingchareonthawornhcai, Eric Wieser --/ - -module - -import Cslib.Init - -@[expose] public section - -/-! - -# TimeM: Time Complexity Monad -`TimeM α` represents a computation that produces a value of type `α` and tracks its time cost. - -## Design Principles -1. **Pure inputs, timed outputs**: Functions take plain values and return `TimeM` results -2. **Time annotations are trusted**: The `time` field is NOT verified against actual cost. - You must manually ensure annotations match the algorithm's complexity in your cost model. -3. **Separation of concerns**: Prove correctness properties on `.ret`, prove complexity on `.time` - -## Cost Model -**Document your cost model explicitly** Decide and be consistent about: -- **What costs 1 unit?** (comparison, arithmetic operation, etc.) -- **What is free?** (variable lookup, pattern matching, etc.) -- **Recursive calls:** Do you charge for the call itself? - -## Notation -- **`✓`** : A tick of time, see `tick`. -- **`⟪tm⟫`** : Extract the pure value from a `TimeM` computation (notation for `tm.ret`) - -## References - -See [Danielsson2008] for the discussion. --/ -namespace Cslib.Algorithms.Lean - -/-- A monad for tracking time complexity of computations. -`TimeM α` represents a computation that returns a value of type `α` -and accumulates a time cost (represented as a natural number). -/ -@[ext] -structure TimeM (α : Type*) where - /-- The return value of the computation -/ - ret : α - /-- The accumulated time cost of the computation -/ - time : ℕ - -namespace TimeM - -/-- Lifts a pure value into a `TimeM` computation with zero time cost. - -Prefer to use `pure` instead of `TimeM.pure`. -/ -protected def pure {α} (a : α) : TimeM α := - ⟨a, 0⟩ - -/-- Sequentially composes two `TimeM` computations, summing their time costs. - -Prefer to use the `>>=` notation. -/ -protected def bind {α β} (m : TimeM α) (f : α → TimeM β) : TimeM β := - let r := f m.ret - ⟨r.ret, m.time + r.time⟩ - -instance : Monad TimeM where - pure := TimeM.pure - bind := TimeM.bind - -@[simp, grind =] theorem ret_pure {α} (a : α) : (pure a : TimeM α).ret = a := rfl -@[simp, grind =] theorem ret_bind {α β} (m : TimeM α) (f : α → TimeM β) : - (m >>= f).ret = (f m.ret).ret := rfl -@[simp, grind =] theorem ret_map {α β} (f : α → β) (x : TimeM α) : (f <$> x).ret = f x.ret := rfl -@[simp] theorem ret_seqRight {α} (x y : TimeM α) : (x *> y).ret = y.ret := rfl -@[simp] theorem ret_seqLeft {α} (x y : TimeM α) : (x <* y).ret = x.ret := rfl -@[simp] theorem ret_seq {α β} (f : TimeM (α → β)) (x : TimeM α) : (f <*> x).ret = f.ret x.ret := rfl - -@[simp, grind =] theorem time_bind {α β} (m : TimeM α) (f : α → TimeM β) : - (m >>= f).time = m.time + (f m.ret).time := rfl -@[simp, grind =] theorem time_pure {α} (a : α) : (pure a : TimeM α).time = 0 := rfl -@[simp, grind =] theorem time_map {α β} (f : α → β) (x : TimeM α) : (f <$> x).time = x.time := rfl -@[simp] theorem time_seqRight {α} (x y : TimeM α) : (x *> y).time = x.time + y.time := rfl -@[simp] theorem time_seqLeft {α} (x y : TimeM α) : (x <* y).time = x.time + y.time := rfl -@[simp] theorem time_seq {α β} (f : TimeM (α → β)) (x : TimeM α) : - (f <*> x).time = f.time + x.time := rfl - - -instance : LawfulMonad TimeM := .mk' - (id_map := fun x => rfl) - (pure_bind := fun _ _ => by ext <;> simp) - (bind_assoc := fun _ _ _ => by ext <;> simp [Nat.add_assoc]) - -/-- Creates a `TimeM` computation with a time cost. -The time cost defaults to 1 if not provided. -/ -def tick (c : ℕ := 1) : TimeM PUnit := ⟨.unit, c⟩ - -@[simp, grind =] theorem ret_tick (c : ℕ) : (tick c).ret = () := rfl -@[simp, grind =] theorem time_tick (c : ℕ) : (tick c).time = c := rfl - -/-- `✓[c] x` adds `c` ticks, then executes `x`. -/ -macro "✓[" c:term "]" body:doElem : doElem => `(doElem| do TimeM.tick $c; $body:doElem) - -/-- `✓ x` is a shorthand for `✓[1] x`, which adds one tick and executes `x`. -/ -macro "✓" body:doElem : doElem => `(doElem| ✓[1] $body) - -/-- Notation for extracting the return value from a `TimeM` computation: `⟪tm⟫` -/ -scoped notation:max "⟪" tm "⟫" => (TimeM.ret tm) - -end TimeM -end Cslib.Algorithms.Lean diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 724233ff0..0af0ea2df 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -7,7 +7,6 @@ Authors: Tanner Duve, Shreyas Srinivas module public import Mathlib -public import Cslib.Foundations.Control.Monad.Free.Effects public import Cslib.Foundations.Control.Monad.Free.Fold public import Batteries @@ -48,25 +47,8 @@ query model, free monad, time complexity, Prog namespace Cslib.Algorithms -class PureCost (α : Type u) where - pureCost : α - -open PureCost - -scoped instance : PureCost ℕ where - pureCost := 1 - -scoped instance : PureCost ℤ where - pureCost := 1 - -scoped instance : PureCost ℚ where - pureCost := 1 - -scoped instance : PureCost ℝ where - pureCost := 1 - structure Model (QType : Type u → Type u) (Cost : Type) - [AddCommSemigroup Cost] [PureCost Cost] where + [AddCommMonoid Cost] where evalQuery : QType ι → ι cost : QType ι → Cost @@ -76,57 +58,51 @@ instance {Q α} : Coe (Q α) (FreeM Q α) where coe := FreeM.lift @[simp, grind] -def Prog.eval [AddCommSemigroup Cost] [PureCost Cost] +def Prog.eval [AddCommMonoid Cost] (P : Prog Q α) (M : Model Q Cost) : α := Id.run <| P.liftM fun x => pure (M.evalQuery x) @[simp, grind] -def Prog.time [AddCommSemigroup Cost] [PureCost Cost] +def Prog.time [AddCommMonoid Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := match P with - | .pure _ => pureCost + | .pure _ => 0 | .liftBind op cont => let t₁ := M.cost op let qval := M.evalQuery op t₁ + (time (cont qval) M) @[simp, grind =] -lemma Prog.time.bind_pure [AddCommSemigroup Cost] [iPC : PureCost Cost] (M : Model Q Cost) : +lemma Prog.time.bind_pure [AddCommMonoid Cost] (M : Model Q Cost) : Prog.time (op >>= FreeM.pure) M = (Prog.time op M) := by simp only [bind, FreeM.bind_pure] @[simp, grind =] lemma Prog.time.pure_bind - [iZero : CommRing Cost] [iPC : PureCost Cost] (M : Model Q Cost) : + [AddCommMonoid Cost] (M : Model Q Cost) : Prog.time (FreeM.pure x >>= m) M = (m x).time M := by rfl @[simp, grind =] -lemma Prog.time.bind [AddCommSemigroup Cost] [iPC : PureCost Cost] (M : Model Q Cost) +lemma Prog.time.bind [AddCommMonoid Cost] (M : Model Q Cost) (op : Prog Q ι) (cont : ι → Prog Q α) : - Prog.time (op >>= cont) M + pureCost = + Prog.time (op >>= cont) M = (Prog.time op M) + (Prog.time (cont (Prog.eval op M)) M):= by - simp only [Bind.bind, eval, pure] + simp only [FreeM.bind_eq_bind, eval] induction op with | pure a => - simp [Id.run, AddCommSemigroup.add_comm] - | liftBind op cont' ih => simp + | liftBind op cont' ih => specialize ih (M.evalQuery op) - grind + simp_all only [time, FreeM.liftBind_bind, FreeM.liftM_liftBind, LawfulMonad.pure_bind] + rw [add_assoc] @[simp, grind =] -lemma Prog.time.liftBind [AddCommSemigroup Cost] [iPC : PureCost Cost] (M : Model Q Cost) +lemma Prog.time.liftBind [AddCommMonoid Cost] (M : Model Q Cost) (op : Q ι) (cont : ι → Prog Q α) : - Prog.time (.liftBind op cont) M + pureCost = + Prog.time (.liftBind op cont) M = (Prog.time (FreeM.lift op) M) + (Prog.time (cont (M.evalQuery op)) M):= by - simp only [time, FreeM.lift_def] - conv => - rhs - rw [AddSemigroup.add_assoc] - arg 2 - rw [AddCommSemigroup.add_comm] - grind + simp [time, FreeM.lift_def] section Reduction diff --git a/Cslib/AlgorithmsTheory/StandardModels/ParametricWordRAM.lean b/Cslib/AlgorithmsTheory/StandardModels/ParametricWordRAM.lean deleted file mode 100644 index e69de29bb..000000000 diff --git a/graph.png b/graph.png new file mode 100644 index 0000000000000000000000000000000000000000..9ac5daf0eef69e2a6299afbf8078769476e9afaa GIT binary patch literal 64547 zcmeGEcR1JYA3lt~qO_EzLTE@bQ&vivN)p+dD0>yMN2yejA}PD_h^N1;$QNM1NA zN1?3Dq)=Amt)aocbQJIUjo)Z=rOuzFERz4i3Zi`}l-(4`v!@j7f_}H#Iw{x`E{@qA z?l0JJdfg@mx^pMDos~Vg>g;A-Q;rvt!>g22-YE_%)(mR-*-WZ6mwkD}ecddEW8ho_ zha6k(&eKQgCnN^0$+5rsIbGHf#QMx_t(pG&!5O=tvadn2NBd}xzZC8qna&mv5)vYh zh+mexu}M=&%YUY1Z(6Co{71`+|Gz((Pw_7OW6(KG&0tP0F0ZQX+qb8-nDX%YM%=$o z=#FE4MRn(*%3C)s^tTaIgMYunq|UGUM+)ZD&vXY-H46ibEW zD+fs!8O6rM#VKfNCjR+zQ&CANE-C5q_3PJ-O-%*vu&1>o%+5OK*()mg8Jn0W;zI!e zj1BemJIC>zfO~R9v@v)TMQv@1Wcgcbl9H0vtyy#EL@0xUV8Qg%)C+%q|NMf2o}nQg z85xDC zi}ar7dU|>=3MCtx$z+zQrY2=`bMrrAWBl*w>FDU}9UQ*Y)z!W18y@CmWo6CD$@z>= z;K~1tkNZwkZ7S>R>})oW7pZH!UX&0kn4h2jv%kM3&L&aGBtGdOTZ?ICnwqbqPl+!7 z={!u0DmT5J>hoYn>JrcQ9Yn%0*K0VS(=lG57uC)E&ac5$J4x{$L*_Gp1*j(DJ-mvo$;l-T;AL~ zX-rK{PB)*An_J<`8TXXn=;-Jg-N=J4jRW@X-Mek`<{L`3Nw`d@*y%iFdHFhB;nw%> zPj9EEXAI@yd3;~H15UM3j_h4J7zaow{8^m5K>1DJiMYTEBihSu)eU zfq}TuQA_efyu6oh+_>?`%S*BB3A0yKO-;>R?c$c@hjGNVtsUzwv-$CH?e%NdcD_@T zxAO}PwV)j~JNycRfBl5{7$WH+zVztPBRLh7mv7#@*|ufN8!{tQR6%Yfx>sCW3OC=v zv&V*o6&q@{)W1(P3KI4G9P#PXg_5$e(CrR31ND-cxz?`(`I01-vP^N0lA2oF)&rLX z0xN0L0&;2ai}Ubdxy_q5OL%(W(&r>3IPut+NF6upE>3wZt)#DCFKyqpEe7Mnbba~y zRY1+4|zWtdM^#oP3oO-#=z+J528+g-)`I` z5;iem&3x?Er306PWRW!@TsP*jAWZ)LwZrT&B(Gh&_K~NjFG3)=ipni5MJ-WceHB?K zeSOB{SFc``eqf!Onf*%*VWkb#!816Pj)tysFDB`>yOYnDZ* zoSfXm2Rd=X&O&EVm$~eLfq|dBy-^sQ&0wRnX5KA9tz)*sUny0TU0Tl01($lU>g$^yLvCvr|Ly9R-f@j?=>ftr_vT*8Qj5R)w|4CMP#x z0v^8|?0V3 z7v{-LYHMqs2L!~WrXEJRiM1W+U=(vmH_soF&~%-jL|RR^&B=DyWQvl~H6W|59xvuN zWjNTFI6FI-?C0b21_|9}q(k$A2VIlf3hMe~ZE>vJ=+8qG!+VGdq!1&_bZeS{_eRze z+&gycz%*SD?yw6dcktTDe}`T(J7{Ujs$H z?%ctH2PHq;-{6~^Y!NsmY*4uiMf`%#aM7ZR7sHWWpCngaCSmjXfrfbX409y%4yW;o z^`e!26QdvKxDFgR?;~KqxWA7XP~evC8}MIepET))G3Y4|Mcmm4Gf3R z+P2&5;CaF;tEClkYp696ThFj9(+q`M84G077i`OU^r-6C*w_^B=1RVXiHSNHakCLl zv!z52kCy>fs%i3{f>c> z9oh=sEMfw;eyfmsqqw!^SVe0&4hhcp@VQ>m(FvoW-B~>_U;6Rmr)!7%anWjIhK6Vv zR=t+W;A4}&)2iZJ7Z=v8TQ}P<+4jD(Qybw>kDriGSj}R0ax42K@{K@g)VbE|8{xwR z(;Z}1wr$_OUtC-~Q8Q0z{@-*H_6%?N4YgdpCkc^`&f^urTeq4zg3$9?&7F;O*5 zVsXB6G106o^YgXCu}A=iUtOBw-BB4^T+y)|^F`V5#Z<^-=1-5qP(~9eFHGjyr;>{n za!Dux>ow=)3#F+g1{}4*-9#h3#TQh>93~7ioqE5%Qp>p+8DihdfE=D-)Op5ZBk+T& zXL+V+%bSWo;lUT`=KN~1K^F6w51u?xLSeh(?!I4=Y`kQx0$zurDYE%g6B|7{WaK?x z@0WTJW6@b?z+=&0D3ZE9r^$a{m+O$4)`bFJcIn#0td2PBCKG)7;^oVQU9)N*T83@a zu{lZ5G9JAd5#lg#(5$milht|R*>FxDi`Z1Np4wZT+r3qx7T@T?GM2Vem-WEl;AEq^ zMSp*EC~#dyluT$+j#XcrUfGi=-k~@7vjg!LrKKBcBc-a=WdwW;6qXsmTJ0A@fd4Bp z8K{rl@r`p(?pH&+zr6LC{O16mlk?M^@j!PaJx?sPd9$Q!o)q2U;k*0!S}m5-`tRsf zX3Uq*(6mO<{eSHrD=MUMtA^$jJygr&qWK|<*>2Xw81eaj8HXPa52Wk7qXMvO&ATMB zR@rd}S)cS0Y-a)EdJeI_UG9v>ZY5+|bS7c4M4V%;XQ)k99vk_Di^@k|78}Ve_vdSx z=&$2zNoj9yADYr@#nR4B^kd19AyTC_Joyqb-E;BAgcUark00B)vu8D?^p4JEWNV-} zPyFrnHtDMj&K)WINA{CRSMhC98VaP`eZxu!1PUr`(soTeC?Cba&wmApK@OiD(yZM- z?(I5v2Cxp}d>R_sY2P&8BVU5LHQC`f(qDX=n(SIr(**OJ9(v@q)95Jr+MC{-^RynQ zKPXxI^Rus@Rqt2&CgkW)d_%0~=T8nG7x}15HIq%+owHkyd!V#9FV0V+NvY`FK~Fz` zJgBIq7GP{_yp4$|e(hHFU%7)xM;c!tNK@KhX;#1BR@F^^oAYlt&j!0F%P#56ecGC1 zBl+RKf13i?m^3D+^4!vs!a_Ta6htQ^aNoOs-}ukZ&wcslH*DBIwiYQIDBfQH>5=W~ zG;Q1W^YQWN6&$td{e>s?iRcS)tlYV1hS?1ewHZk6@Nd)zU4OLGbA~sgA*V7W(PptV zBVQJ^tU+1ZITBf|-KI&i;zh>P38}=qD6^bSp+M=BloUoG)0fEX2ZXbx#?m@)x1xXT zBLYUXY+`>t?PEOQl--!9ZhK{Vld{Lu*Z~p_LmktduE~_+eJu5}nI+0jQq`PQLr#OIEx}NiDVpue=ijpY)Wp@^A?K&a51b5 zI*K-?;XJFebtQi$Qcrk&y@J?iF?H@(DHDM_1%JM9&33udO)UHyVUlSI6n8BYGHnjS z%?F+w8$NU=AS(J+$Vg%O)NJ~s6W>%`y;7fOS!UzBNmFV@Kw+Slmlr1ohwSCcPoks) zqt3I~p9OHPXfzvgHXjl+E1%!Eetq5d4<3`)BLt{-I*m)W@#edGK73e{YcrT`-7i=1 zlK)Jo>p~6|(_kdEtGKnPh;Rheyn+G(zwl5^z;YR6YH~A+HVX#a@yXoiP^4G3k(Bp) zJG81FY~IHv87|@F`NwP9EX-BeDAN)F^4^T~DwjY=B0QQ$!rm1S$aAjga zRboMuSwW}pH%s>)-Q5{>V?Wl5DxW7!N_2?BMPTpT#f5)1$g-v1-XF~YcHDg_82NZ>9L{7Ct@O z7r1IInv`d3$Xh$d3ugzofQSr#e0(So)9@2m!{kO$mH1+QsW)q`ovADLd3}E0&V;ehlR~1t=2_o zKkORk3uk%*C#Tvhw5xMOsevAO)Y2~;kO@(^c=1s|`EBa(rEI-R>(;Hzh)i3ao9w{j zPuZBoUGk;d_V3@{?J)Kw_skjFc zrW)Jb#9HR-r%z8Os)jEV)eDS#b?Z7kpK78iZ)mB%<3p5{iD=UiWYw(f&X+HD62xI- zWP~nEXbK^zprmxG#zyUG&QzbS{>PFocKQ2Cpm^dmL2O4U=&vhX> z>e8z>EMgALdAmdo-QmF$h}`qna*#xOA8^7s7rl}xS!|d2+5R4X?Z&K5mv~f!bXET- z^jqDMSEs*OdDnOy6c^XFD40}A+g)ay!Fl8es2cM}k00m%%02P#_mO#|@X|h3*SRaK zPNTPf{PC#|jLZm5Y*5B^wr&-x33fc$=%n>PD^dM26u_7~2{=cGzu!H)W~60` z+W_P@8(-7c&$R!Y{DPMCghrEwl@}7|YcD2Y#&MY-k=Mv(AsH@p#oY)wC2)8Ai{*Sp zrYR-T^0Kw{JvaVM4Hb!&s*!n1@5!^~pB6=jbl#h#AdIo9rzxrDUOgzD*aIPUrvVm( zJDt*M8q#>CXLJ{xgxW{ISr{WjmCljXnV+aL@XBk@3KF?-`iTD5r$C=bB}OARySg+O z`OZ12U@p7XaU48YgW$+OtGKkD00?b!+fEr+{`|C=M?LcrdVGb`r|*Cf0~c~|W@e_} zw&-85kFT$njSPYuKt_?kJ}0MqkgY~!=JRJ~pbt=}&lriT;zLS41ckC|pJVDb~tWuHMjt=q6c5nGa7CM4mUC;h=adrm!j_Dn5J z-|GdBdK4i%jx~Y$=l#Cvd6IaE6>R1;>R}+#0wZH*!J_(GJz7j(dpDy_W79{PCkU4#{+6k`GnK zu-I({A$iAkDJN;P^!~FhG_l_^sidI5v2WiQ1b^;$<*~_TJ#Plh<4jCU>dv9=?(XU~ z(rq`3K79CK^Shbfi$zS0FMsq7C@PnEzU>D{2aTy7Bz^HnN5Ld|r4Xy*$GR3Hwh+dn zI95PFz_2Ctx+U-AZz@+ps0~p{;TO*2_(xJc#g5}bU8#n=vjPN4|baaoCB2RKH zQ7*+fpd5c?G-=g6+RjA;2Y$WMUx0bl8-%}|RV(cI$UF>VE<#jL#@3h|U_q z27oqd%{wl_x|Ckh>A-)f6}c3U2O$_1t^X3DMAt9~Do41qYz0L_6FEkhT8@eORUwIa!@1>lxd$y*ER!`0$OdFn&i)GbPB&@dMgMF#+VzfbDuTKn*G%@; zohO9db*htj_0`p3=$MU~k~CX0O#DH>5sqcgnfr!lG6@tHwH-DcIb3sMX~bd9TpS$L zh~%V1^(^D^7d&68s+1AGNjbfYq^H^^@mMy?yd5E>J0iED*a*d5Bk$HwEjWk_gDMt` z@*p?&CB4$eH81(~tWgJJmKxrzLv%|#U=pv#M&??y8W}c&N}viV{*E=EH=i7AlEG-? zLAih;U%K)hT*?T4FD2~QojX*kR<1OxkGUf8vH?|jp^oCuw0uD=tN_7&fGSL2`V0|9 zqBnlrWsAjq2bz*Y3E2liE*>5KpXuo=s}hRkbx0u0B9_H#-V*Zd*|R;8NDOs=&4Sjy zWYK`xfa*I$H&pDmj01vVBO=a%jhY2Yef*XSbsYc>#Hcdn;rYv#q|C;eG$o-PKL;&a zP)_6KDF^xwS%#377iDCGwPZkOK=C4}>i=L8u?FZrzja)vUgn&W5k885R&w(4Hltmq zn2+1ZB1ii*82f#`CWpQ@*LEc7VmS01U>x;siV?>s`v`T1X6GzmVEjA`3i1+`0(M!{U9NH*p!u( zOFn)ie6@sBZB$Y{_<^nwhV<3T!}Zh6P(zuC)xWJ=_fjbOa`0g_2T3_QyKI0y5K7lq zYC$_7iIm)wg{5+L#mQsW04Ska1qJOw_9eFkDEd-SA^1K4(u&~x^Xbu1Sro9%8o>;@ zOLTsX;m9)ceEy28Y#6c;sDCbG#g>*93{s9f?vW#ei2;C+^uc=K{-V~u!u}Ib_U=86 zJ`mtR0aWH#3$(CG1DdeROeHiP=ohR1Q_*m9(jkG4C9wB&{E@|=^AI91b)*(Fr-aue z=JZ=BC_LBD(D?0i%dLHBPg5%2>!*=HFfcHbsvN~5aY9Oht^^)Y0Z;4Wea{u7v8;lSL*2d`C9aml|kpBK4CBlYHG%pkS-+*8@B0g-?1Ye ziU($?B9ji$1M-cCQd_s`6^*QR(Q7M_E*rSANv@~I{& zk*CkjR*9Ag719dq$VyMZuM%h6ZRe?`SFfA+I`J@!BLz!>a3c781mBn*tC<{lcu0*9 zu;ZaKA}}Q`G;C7{W>CqPSn%hG4OofC1+nz{^=n87@`i?nX|YBvugV#!)@A=#j*@gQ zND((~q(I<OBu<@e%69LT+v{HSRj=M$mD#V73@9T5lds$E18g#b$w(W)w$!otEo zfBul}9q9Zggz9H$W&;270zkPTqBY78J_a_9NW}5+@!)KG00P|H+_}B&~q~V@wPB${55R1{N0^dj;wSWMWWY*HTm-Peawl^c&La1dsHY zg0QBdriSWuEnlcWylF0~2{WHdp{l&SG{?n$P1~&Th0hRV6A~_w>p|rH|C8^LiuZj& z8OHtPa3j*WpgKVw-?!7qGiuluJoe2SH=aRz2V=BfQcFwg&*(dT$vt)@)N*Q0tnI zl71HnngUn}q!I^_n;jjwz+~Yf|A)Gb$;FRWty;yvvj9c{V0^`Pw|J_h!s9j-jw!<6 zQq>YuRk$JT6B!5@7y|HhWRELXUN3tb;!{#;)?BOHbtE=5wRVkrK&F|lP+(PFLjS{C z2KXYrUZm!F=FFLRYA$i{BBcz@o9K7IZmNz;v&*N+R$|GAhlhO@7(ND@wD4s?xAyV$ z^u)9iD2tec6o$Q9UQtoe+z48ag@uKTfM~>=bQIpxoMv3aj*!k25)v|G9uy7^dH_k2 zhyw*uD<~e_#v>#>{uq7s|NGPb<2m?Qi*DU;Wbe`>))Ej;8UdleikDbM zzQBqoa0YrI*o6=Xk~S7ZnC;BiFyCr##?aQtFFevmH24UQ*H%R1O|q(4r%sOJy@f zgg19DSyMM^pq4Aheu&DdoXa5Ha&HYetcs_ic$`%}ORjCnwr9^CLiK<9_N`K_7bzkl zg6%X9<*)csx~6pLxQqvO#=L(0Jz)kSZ<;|>=9zPpu9v?ats!6ESgM=C0k|h9C|J>( zmz~W4s{j)2TlwphF4_M+^Q06(3C!-3mzT$1)zF{_>Tz#9mD`c!(&R=RAZVhLw&JIz zhQ{-tAk(r(l;W}K|3?0_!B`P>68o7=672;cPA^<|5X?nQ@i_J00L~)b35Z22NuUql z&=%tr#eDx=+?}XN(3nxq1xy;j?NC!TmQ{2Rc85~j0Q*fj95|_|a!81P-t?X&D(2X_ zpf$0tkOV(LnJ0a;P*^@mxA3O)^%-13N}3X3ro3HWx&&<8q{2`D0W0Ltlm1sx-@Mt2 zGIbD85ke+WC6F4B>iJA~R;*Yd@rjgJV#YXomXrxJiNv{pstwf*sK-XtWQAKfhu=~P zrKr6_mxG25VBzVLT}R(Qe_8sg{htT`ASBD{34S?Wuxcvqr1RwaS|asQZ zfUHK)pOUn+7aQr(moZDXsyv2{TE=T6HaR)zFQ7wmDLf;oX=z>uxwxdzp?;~XR03rV z#+0yh1aK=SYr$X;4I(QBkblph>`P0VJx3vUPHrH9U06P5+1TOhTv z+GTmi8Hy7*4vLH+QI64W!sR3gCQmv@MCy0_qL>Z_c*5G$0f7P6+ zit`niGj4QC08q4B*GUsWmi^MpVrMGLJIAZ z+;}sbH*x}okEV{u?^L^v-aHFx@C6|P33v7RKxjSWTjH#7^rtBv+f3*UiY1G-^Q0fS z12aAkI;|R?Nrs`RHIG|^3ZPgmMfV;GMiHTn_zM5N0gGfhl1dTDR8V$QCP|D^#EvAB z)qX3`yl_Sz$;PNIO4?zn#b9kl>$8{`4j$Fiv+9|qSEh&CZ9qSoe0|9e5%GC}6m?he zf76lD08W9>49^1tNh57i5g<6lyWY)xxvlGZ zN_6hL&iTtAN%KHSO<3nm-acSIKqHK&|ePtQ#v6&&+!v=fg0 zD~tIL*&QbnSf-nzLU;-eK|w_><)nH%GT-1B*~cZGJHWRoVM66mfl-8r#$EvB3%wUH z85I5-KKANTl+w@;qNfT-4Q=>McDBfTThV-5a#E)f(F{=R#9B|Ab3Ta?Sel=9@^QXz3W^Qp43@eG|< z#H#i5zrdCi{Vv00h^1H%X$>}p5UT=shlpBlW+VKu@qwo&x~^aQ+d6xG8fHw5bZUF< z;A@1pDR$raC*b@kw;D5VrIXdSe3d`?emyc=-JMnIlRk|RHD0n7PO8ehkift;RT;f+ zNMb_f-(ui?#Epyz$%g3#8F{nAnea_uCrkSf*f0vuCrqMCB4pw`^kr1BI$TJ=c31-) zM8?#F%VcxBQerJhxP$=&p2DwyW41}CeU<7abtk8RqeO51d;ndOR}#&e8VIIUO-=Mx zeU(f00jMIE;V8)2Teh<6rC|y|F~!4Ba~hL0&y-~3lMHVs&wL@<5vZ{GZP#Jt0;`}LB1NXh$$m_m5Q-RLgWOwm(I zRFX7KDXE`HfLY0%WD{gJY5&9ZYXW3@V?qL3xyb7E)&r>KwI0%kC6_QD1@}pa>Ws z(k)LOrt#H z$)V07Z6+a8S*R~;pJ6#bZc-xlqg-C!&(=z^*grcF2S&L4;lPR=&a{#+`dOz{{ZG-= z@R`>(2O3{TN2d&=j^0e?{4xmtorGlA(b2(k;??NQeqaQ)ems;}>#(1)Rt-w~1VsB0 zMiI*}=qDLYGdBryvwL^fn?Xnqet~T*!6q=>fCaYvd?#9aAdK`u!Nl|EX)LzfJ{ zU2aoe%e$-{i4+#C_{_|yN6c0r%zPq-+Ok4z3y2j9#aWo@Ep~Fj-yfc{Sg;A?^cd|T z7YCFTL5z*K$aZKd%kTKCZM@DB*XEtwIdlr$IB+BLz(X%e((&bjeoNT0>m7QJ@>} z1qB2yG#;vfNAOC$(T#0}7%k^%Mg=Fu1tHw*z}+gVtW z;4uYXw50LDK;R|%ghkBw__>?l@)-pTpRyUjPD9!USg63CG$g7ELxCZ_TWn9sG`-Fn zWz0lxB}NXoPe3BZf~F@PJ18-Ax{0XTPua{`QqK|fdHd$gdtjpkRXu>GDcU=o0M3tC zjUb&RAuauRv}>!|nTz|E@!2NiMUDW-oD;m8YK75v(JfbQy2D>^esL3gX2tyF1Ko{Y-X&eq9K%?`` z%Cb!xLR*3+W3MC`GERuF89{?E2J4q;jwuKAW&?v;nlbF{4KQH`RM6q%!P&ECJu}$Z z*a=EuBU z>)~7-(%h011~h7f+JQVt05G(A-4P#(2>o)u-IZPXgc)%uumM7Nntny?R+;0kk)GOs znf1W|tL0k95^ojceGVQTFWL1cJ^zPvK~6eDRG)3@T!T}DK!{u`ry`Lq&HVMyn2bh*#6)BxIWR(;2I%)(fjxBe`~T(`c5yAe8n@^!OmD&wG3lF0zAo>U|ek=eo3gp z;1?bJ?G#N64XXkF37j{EQ4tBH0iCiS&<%7?X^;XiNV{1rHwD#&F!dYb`5oY&CZarX zJ)-qs6gCecD!bZE%{^#fNqw2gQwG40hsSMM0IiMmB=-a;0$AfjHv?=4K0U>%$Nw@O2^5PB>LL+w z`}_L|?EyuvzPXtLUU5`PqfbxwkZMTEFD~KezoBdS%manOV`OStPsB$eRGx5BAzcJ< zS;63e4qTEHZP+4E9Cs3B4zmOuND1T}Vs9JRFU%gXd{1hid$gIIF!Fo;oE)54R=Z^3 zC&Rgc=f1w-;6~9fUi5(tq#^t~-Q+-n6rq}61Zv2$wE&@UkN-18WXm$LF!V(BL4qO=15Xr~<198W4%(a3(e7 z!1-k||B31Fw;Up~p`C&Ii&9(@QJcAqU<(T6@^XRs|Niv7M7 zi31bV5I-N}RRXI$M8|fThq7t8db*tfA@IV}v;3$(m~|5vZI$2drC4fM zpIb?uW;J{sZ*ab?p{Xgl7A%LdkKNdS@XVmueKiej+Lp;1VV{ABYnQkg3sp98;#jDb4=|@Bn?YfLW_RPF^0=FKHasV}q`s{lAOD>rWKN z&-!UbaN$q!u7+VEuwXr<>o3-)W@Vuy4%@2A^kWM?tV`;5rwLTuzt#LZ-7KR~Kf~FW%Y>^*i05B#ql39{;`3Cwy3{Q)Zecec zjN9+j(Rs;`?dm$3m!yCH)Xt3?X-E3HZ;0#nhByxA3_A}03mJ6LK9F0#<@B08?x&!` zp9)oKub}3KoxIvOLu_`q^3TOPyNfF-HW+6xGJ4Vcn;sFKnW_B4t(lUQ#IT@?)2A?xCGmD9jr>^c0cfS}(MG+7bd>t8iFZzQ*ZvvF=I?DEbW+tXUUTWRF z&(?sLrBG5-XwRQNPjSo3JNEncZyh~7YMf@K+<$fDz<~oI$Bt1`*tV=?J@;_c6n@&( z+e_0meJM6Dkcs?lczC0_dK-(uqqTePZjx7F@#wjluEqnPT~k|oCn}14&7IAp(EXVNn=UitCD?*i3t=gM=xhlcD&Kh)GbTP=>8*d1h4Z>+4`xaHx>laAGA z#lydMbydG+yUb0`M9Y&{#A_vP8{U&A#kOV4%`2zgIOEjrs$EcSkLws-imn^e`R?@s zTSl0}S#a`bw?HQD+r;VjXthX7u9~{Ky}nj>&FEJrdHJn;`y1&lbNXFO%M4^T;2!@( zrOW-G^somvrJ-=6+yA@(WmLx8)CZqk==%Me7AYt@H}`!@3&WO&AG?lT=UltzW2#D6 zbZqQe+@AT5_^drkcm75$wj-5;Z{KIYs^d?~N z(+fxm>%8Un`$jM-kzh$ zdhvq3zNsm^u#m;Z#zvOY5C1!9VffqDty=8Xs|pMVu+zVss1%-*v=O7w)L+x=bu8~Q zve9jKcj}Fu)?WriO+tj6%K{Trot`;$)uy>xC1 z-r8EPcrg0{+Z`3|;iqf2d6sPQEWzm*H(%eau9YvYqLECMGsx^`hvi{Vs$;NHTs$QpQR4(Q%JWwJTO-KIk#bP~+IP4oBbL zWM;lFsD6HNKWISO!^Xc05Dg0~@q*Xaah(%cyGVs%gPVbkE2J6C>~=+t|44h9Z82M3({ z_w@g>_4Ebp_~hh1dzN`8?;CCx#goGqS>hvgFR^WThiK7WoLIk3WmIx;#>@QeWa!q@ zxn_n1E(He#bzx$uHBk}T1JFD;96z~Y&o#?_&Q5tHrTewDa_;t^ zbAz?4R92`NH2E_XRNaxkyJ@hlCF8!}hT(w%pgdpcOVXM$koKRzm~%P#43KBN&t2MU z+nV<>gCGmb&))^C850+G`ug?#0Ee=QiuZv1pZoc}PEFl{t0NsBQT1y_l?!W4SlAc% zxGxV9e`_*j&)o?@CG|^13`gP*zGLs6;WpHNyy_=>Oy36wJwf68ot=H()U*SAoO@^} ztCO?y_wH_LU}8@G{ny+!t-Rf5tHM&Iun-*=w~pK&aSad1I_7$)&+NX!iLo(S<2 z{a4tObF&Q%A368ET=&rtOIcRt(Psd|F%2#i(plp=JUA%TBz*J86&;fpG7NkBqrjwg zG+wKc!H&bj{RE)8zP{dijY1BxQ&W?_^3} zKRv>HyHn-iemE%dr)gG@(bUXr!=2jS5*1}-tI-4;=P3DeHo@q~p1Uf(pxri}N(L(s zQg*dTZvG41Z18lN$-(t^`*-|J$-jK^Bn8Kqy88OgJ9|9qcvIY{)Aa4z*Z6!U@l>FR zPhr|L^HDCC+YeA@?T(!2Zi1NF$LxsO-G4Mv?jfFm!|$Tj*1LkQU^jzpZNF=hxX()@ z5r6+3h=xj>9CzF3UBAnRc2#hXBg|fZ$Dx6_*EFl7F?B}?%_g^uW6W2+@4_;>Eljp3 z)S1rrp_`!5tbJ?FJTWdL7yJCr(TF^bw}MYI($l*@44gT2YDFmK9^T5wI7+o`#}1~) zANOo|NW1q3oXGh?lt9efLD_R__E2je!CGu732;sGxiT+V6zitKEuo{c8$aK?Wy>Al zqPzF+GhPz7$;R+WrSO2bc<1g;c?E^Lu&|M<(z1O2`SYWDLBf4KOUpy9v}@L!#FvqH zd9oGnZaV!qwqYrLBO+F!zs#4tlW|D5X|A_de}Tckz+fc}&7S}*ATApFAXpH;^wDZ= zYffeJlF-|fty?udK91Lpc;iML-tK4jp2Bj2XtJM_rq9;B%?$;2y~XA|fH$$3nT=tu z6pf4yS{Q3#rk?|4a z{ZS@{?l3>t!|r80*mU}Ws~pERFiC<8bGnNMW;4D~Q&G`UY0laQ;iJ_Qy+%(e^?B*| zhP`}zbg))_`uzF(*7X`GoG*ca)@4a=^R!k}L+^>apoB z^44u^LNvyQAe2956kG=-ALl9_Ja`cHb$9=Z%uJze+qUgKa9}k|_opsj-k79S@CfbW z^XJb;7ZQLuM8Dbn5}*F_Cw272rqgQ}Xpy!r(Z6`xgl>`2`fr{byg79Oc5uAHVUK{o z^MKcM=G&SFxUjJyt4Z9tB}6U=r|Y%r*I$Q)xlNC6+PQO0tiq$WZ{Kb_#l22rGb-20 zNV%3hzu;f3qTUP~_%|KZOf zH~lE1pz*d1n+}V}>Xd7!CDNl=x*#J{h7*U+LPDN^_l7@~{-k4DC;9}$B-no{G`(xq zuXk7Ayr;sQX*mG!_;gr4zTs0<)p>JsUhJf&fq~`jTBfpFfJAYQ>SIaCo)afnU{l>G z<{;28no5*r+~mB2gD4#B9^@u5F>6l#t2k+ACxZUoZiD!(BS`#Lzdzp!C>{(}tm_o- zJiQY9C_VQCu+h&eC~Sk4IU{iM=Y@e!E;_G^8@*8FyKx})_yZj0IC|~cwXn#@Rj8W} z9z8m3Z7l$Gb&uc0%`7aJ!v)C#ZfU+?4N@T6VUiPU%u_$VdjPy5A|fYw{l{r_G&FXB ztp1Lm?!V^CWN2dY0Y@P1HhD@T8^29UbHBuX#>we8Y#bFPzhSezGQI)NsT7%!(GaHU ztgp`wU(2&suhs@%UX5z}nE6=a?&kfzpLMYN`XlHRw>8(=P7Wvrop5G^!RI|_&O7ij z|FRYZdfY22%6Kzp7yd_AyM~S~`Y{sFrZ>?U8Qbx=pT2%QDCT~ zL%MN!_)YHugn=sdgfhIBot*~HjW$KecdQUsg2&=M&a8$5|Dx)SPEVi5q=AmB;FZ?S zFy3BoEJ)Eo27f7JrWVTE`3kbJ4lESyYK?7eOp7=&={O-KTnAyYw9TGRJ(Je<+YOI< z@&bn@C;5->eCgOR_pfuY6vudH20@Yicy^v8=eq&=7a03%>g!ihuudP~w`nbZJ}qul z83-MJ6<&nkkkurnGWAYJRz>9jbQQ!&*N+m|IP1I?r$SC|T6y-|xvMy1e*A$T-k%W9aCrV(j@4hhI>NH&%k~%r z&c8D=dpJ1OpkMxoiQ4n*!dJCU9Mt|hI*uc0p@$4AgHC7`9)UidiI#wenX3aCUsbDJy2&@m){3|DH8e*A6p)?Y{#2X4jj-FRz4H{6qPU%N{a^d?-vo;+I3vXz@^w8l4rW|lC?^KYOBR%918hqApv;#LD zt2xhl6`J2pe%-VF<$-!Q^EEm)_70|lCy*<)C+GiJclykkW8D7OmmqwK$~vu%B&ubs z>#GVa8?O@gj+Kv|YMXvJt4ZU&AbNi_wN+IhJeAOUM#uMItPly$ojiFmINg945%q+OQ7hD;qiXJT32dSCFTJ>eh(YlN(j!yuv1wgJkXxjyg$e~m!w_v1a6BT zAnrx1dTH@pP?O{X-I4xU@4@$f9~v_2zc!VFO_`vcwGryaD#Yv!oPB%$`SV(Eog#Ll zyNT9>Evp01huyE&9=Qb_1|jw|I51qCR&~M?F92xjDj=(c^Y*1U>4U`9(etPGrGU{E z9Q%3;DS~7d9GW_bN%836)yURSqICM;4FG${V&D|yA;_gI7M*$nwhXkhgF9Jh5i#aP z^S2P!W8>ZMdVPd)uzA<6Z~X=*=0?vr&Gh(FTGy|{YnEoY=jT6v8!u%{W~TN+4`}h^ zQ+-3jcW7XceOO1~uF`|H`8Flx)alby`V|595S>VCt#@KGPc-g$$6wpncpqH#Rj}-T zM_d=z1FeC<{u(02gqK8|f|{pDlR9A}z{rg~5553N8#X74=aGABabdw>qvqm#D7(B2A%19tD;?dHvXRR8PCQ?552czNBE2=AYC zP%+EIp)WlgZfEWgp3I}Qp0}r+R#5(z!}rRu@Dp>j4&``pM`dXIbt@FQI#Jj@o z-_&p2T%ws~3;bZ# zez#_A!74spYVM>fM>~Q*XCKV(+ySv!Zl;F)$G=zX6E72sB zkeFD4gRbsmwV?nt=i49odGjbNTX&F&=mNSecBf@nQ_V^NoiD&&K_?fx4F~&3ni_)u ziePdnMt&drxK&06ug5sEH+&9`M(Q1WS|1@tckJ0+jEovpH|;P0y{r^~=B>`VJ0~=g zk3vjbeeTG|Lik-C!R&Q9Rw2O2b@v=^Z)!ci(>~3izS}>bC*D`#E=4ZAqN-|i^A+@W z)alDcy+htx9 zSq(5vq6_Y@zKY9|=kM(9!rsq@foZqj#j)N%3tc??U;HkMo)voXPN>3ZvtjfU5?O!o zt+5}Te7DrlLVuu}wtxK*Y4i~c6IbyTALm>xE5L_ap9D#3`W|%-)W)Sk@l7r}tW*bf z7CuXw8b5ghry1Xsl&nIgU4fHBmw3}~A{bar&h31aZ2qlpm!KPF4<_ZoB*Yq)oxKz9 z7WjzwL5xB_)x%-Gmq)GG7f?#UK33F9GN&i-zExCL_e7#&fsSR@F*eu+dx#?AfZSUT#0DN)IJYj{ir84u1CZ zDMe>A_()@MXD2JXK4iUaVCoZ8QmF9Og%c5S2jMoX?yvYFI|+9piISIsCiFP1G>Yhf z&weGcD$ByChd6EQl>jw0wNYrk#dta>(AnQp$$;>}kJ;aO=k`7;`LpX{V z#B2CWfL7tfoTkHjpR%`ti2hP!Ho6Qovs5EZJTkGW9LH&3`U~yFXPTY_Ry8)#gWR`6 zqQ8Pp4I%#yL@_LJ5|=K~qO^PO`L@BqTUF5}5}|e#-i@~z870`fcIp$axlyw?{nj0R zl~7)}|HJ$Dv|8Xlez)iCfK38)9QJN0JeP-zY9n}$)h&*PEv3}{G-1r z(&}Q6%aJtX#ct$$iW`!QE~IkytVvS#aVGyRfG{$u4kD6Ws-9OX{{g(-Z-Cihm?Cj5 zI`7rm+G>fHKLj1O-vU5vdE>?@q(<^m4tG5#xRlWxtfr7EYiVn{nt~|V=1I>p@W-~l za-sh-2nLmb3jS}}ZP$ifo_Kqg!DxcspUO~x5qdT?&PWd3nsq=gwH*ij`H4CEINUL# zfByU!fhxKa;Z5oukVj*`=-V3KiF}>FF}8w>PYGdMH$O(AY;q7w1;Pcg_od zX4L;v6-SksQF=YddP4LAhCH3+p4B*j+Ibe#HoAii!opchyvNX_xHq8_#2cUJEYX~x zTJGWIrj>fZ{SNyucP<%cmc;-YHin6@J_`sizL^6Vd@b3|C<|a(JdhB_=gwLH%i)ax zRHDI^IxecJ47Y~AJw%>(os+|Wab?4RbOXURew~E-sFOEV6fY~IprNC<0j-RkVDZW# z@5(B{o0Cw*saCF9b+xnewmF0z(l$}L@UDP9O$Acqu$_MW-!10lOP4;vMaHL5x7)owKxBrg!aea`N5xXucZv(*@y=@7}O?V>P+$Rg7Lb;BnM|y*V#jZLHq2K)o zkUjH{xGj*iACe$UPv3?L+njoRJ&bwwv$sY%yzro7<}`p*pi*>is^{kYmc43X;tAzG zA|hhQ&nNWd_ezWfjektZCM9MXmo^A$d`h@ZQ z9BDex;jjUFqqy$gzke0l8jqqP@y29rZ%lGnc@>{_;V!(Q?j!Ibw*R%8uV8(lfq%9H z-odwcp%7T#1dW_6#D}74w5rwOFdD8e(Ws-z9}bJpjZz~M+(#q01vJtzyw_(1j`ouz zhjJm}{TMH+S&LlE9PoSZ@!rwzV;G${~Fy%4UaVik1p z-UT}(`&qL#8m85&S94=MV7V1T19cxSKj;Q<2#@r=&JTF~02u}f@?+A$c+j!3{5i!# z`BYv`O-Wl_Omr5WtZ#P^TDmau*x{8BD0dG)hv;E)@RDNe7*e`O9~eTT2dm^!5;m6t zg*E`Gp8-AstbT|&dFiJVHh0f1sc0e&p`o3&a%>`LX`r-A zQyNqfO^%UdrHr&RsHCNmv?SU?sI<_O#_zi4oX`LL{eNz5=W}lFqh7D)yg8UqKe9WjEL!73H|j~P*@9lnwwHvk zR6w7B5}$$>d?J=W5`P{+XfY0I5ki~C^nIV-jjiF~;lAk0n!uZTj&ngU1LRxELJQ3+ zo@!j#DOw0l&v(>)A}T6^z>)v~rZ_)k;f#NnLSg{QE$;9<%o+}q_$Rqy4ifs|+lnsV zmH+}A3;Bxy37>`-cL!Ry{-1-*yhd=!<$~@%Ai>u2vN<` z64yNyQ7^0NZBwH_EyB3JP{)ctJ zrPVuVxhe3VeR}@oszFw?vCNJ2F$dOhj?X%nDNJ&XWL`AV9bTIlR7mKc5-5wLB{K<1?Zx4@-F4s;Exp-0I11qGVtNKmC3|FvZAsRjSnh@;|U~y+O~7&=gW@it;kOlol!GP z6yKyDWu%3Tyfb*#aw=Ypdjp$*8x4)A1eMjWGciH@9m|=-%Ow%R{A{mmk7YF2GY=&>img0sX!y1h{S^lW27tG;0^{ZY zmC`UUSPnAc``e|0X@C#TfUfAQ(C|Q75g7-_F1?L;R=lRaF*9#TXB$%ej|=dmGNm8| zk-p~6@k$&d&jXj6{(-*9?e%CA02?mmStJ>>Ho|_Eedr=VUuIMV{794rV#Y77w_cZe z^4A2b;OVNu4Zn=GZ=aVN!J5bF_zO+`*b7jFeJGm(tNc|ie-dvu%5VUcRnq)PE9}*L zOyGeHb-84DX8B~L{!fx#xq5Yxkm|xEOZ?Fvx1^b0n#;lQ3IVICs>&BHfgSJ6-siW$ zwe<9HPZihEy8cp+8h#@q#o%t)9n1~v<6d4~9?50T8M-jEN0AG1y@tL%ALDwu*on@s zU(YeI&WA8JTw!=X6oD9QW~I-+>$^CX_i6ZajrUWg#rdG7i-2Svd8btXo@c7mcMn>? zD%A`00GiKg;@SSDN^&i(^?}GC1V7am%sOe)+R!jTioWYHQy3I4RYt z6T;xJ(cI|}n4`vEu#uDmWE>z+&Th9oqkG&kFf-Y|C#-#{N%UlLp5c+$Bv}FXwpqQ6 z&lW&uQh+{Ph;23wh22=>R7+U%mJCm)mL@T@F)T@ki*<81NlpIJPqgD)vLk>-x(MhascMw6KI0!OOzo#{UTD%Q3OzKAlSxpF(H9R zZZRZ1DJZ>^4L$86v%H}gVPe?dYtezxz!>(X`y=Jwm78nbIHN53ryu`S>>)ogIsWlf zhOLdka7w`@ofA#Kn`l0Qq3TOzkcQA=89&H=@cV&cV`HQFqX#7pK6aPogQpjJM!jrt z|MutsHTZ4VE?SzJ%*<+CPcw9U21@z`8n?*XpDGw@Fnto=ItcYnm$=-*vPQ!!=egMH zQr3rmDq@n1Zos7>VS&WarDqZl=gd%xQw3O_m|@+A0ic9w0rLdNvgn?=oR4k-R1C*X z%yuSFqOnx9Y<55j#oj1Hy?UN-e9-o{ZQou1d#0=>POVFIe6EA@!>GD@w7?J17< zZoF=MI3-GZQeWta`JRr9sba5=A?Du#IwwqPD~CbzHqSphhah|aW`xjsGd%FX53Dy{z5nvBWF-6unBfehmpO!v&PFklYM&8M=v^2ibWDo-!2Nlv>jAhhMojUb^NgO?>nBj9S zu!4)%C%wSr>_i*#&t7!+z#jw%zyBBhCC9!lmzO2)(=QllhgiS5Q3llQjt7sy?MDq2 zPej9~+@4O)?zsCkQ1jd}Bk!r3BA6jH*6OLPw_fY|qavU;715 z4x=wdZf|XTZ*X5W2$Z{ zpc)1QIp#AxFg=_l8YsR0(E<0~loAK18@&0IOzuD&RY>h78af@FgNvbpnum#n()7e& z^u|<}wi32|S|}W`>^lQgaB=isXJ`{+Hif#R5L2Uu|DO0+lD%PF$m2)-^Sq~iSupaz zN-yqAX($3agr#g`YskJ2?@Qk+!(OvXd;mCYfco9MBh%xDl%VY;oXuV)w)LOOrU4B$ zM@z7OT8>(bkH2kJ`Py~S{LvaZ&x@;4C!Zwc)_jDz$%6&-sqpQwdN14^ua%8jD3r@* zlmn!f$yl(0pP%!F40YwG?jb#HmwsP<_-fj3nouD(m_t5nl#wXZ_e3Naik>r2HO~eP za9z=DBZ|3kn**HI;!u;>G-oX(Fc52FTJ=KvK}|cpauNHc7rq$z{D?D!R0#G_foek9 zG1Z9jTsXO2l0#j9WF3KGOpT)%ugmpO!K7p?{2e3tWan-IcF_1956iX2`64I|alwxk zmM+Mk`W!PQcZ(2)`-uYNBlos@$;nl{FLQTN^n}{a0Y-&T==xVymX%3$-Hb5xlAb_| z!?J9WYSwjE9vA+EgA>EsK8t+1-Rf1YWd1H$@pZ+H=*bWNvvItxD4(nh1G(XTY%D#K zw1;2Sk?ze!H_aQH23fkIthIgM?ox>F5C7sLZFtDjFLysEgp2AqATL2-8GkoGl(uNF zv$BMSRq&7HtdC$E0pdqJJYjmc^&sCeN23`U!5@G@R&Ln9iAGvt?frM%&SNN!inLRY z?JC5^gQ2lK53>`XM@+@panLW9vz1fB0zmIvt}+Hh2x}PG!}?D5`!50vFfR10eb5cu zzyYAsC+HfA0KvWLT()#+`zD`X?4VF^Xqg|Ka{(HJj$gMxQb_$hCHVz?i-wbvB;Ic_ zWcSJ{pfaGrbq)LiwZ>cqoof!OQ9&j5s?XD62Dg^ZJ`L#JXk^bZ9J@gIlKmFBE_*^L zZQil?efY?c*vh6sbNIRvS_U7n>?;G^m6Mh;fre?QJUu3xvMNSPZJ24P>*{jfPQtJR zEewX(U@5%mJrMkCTE4~9G=M(!4+16YL*0{iR0VzTh)PlK4r|RHH z)2Qa9Ar$Fcyu5!gxWM%AM|mrZD_+n;Jrc)|c9t&}7njhgRjb&@$}azB*p`v&;>c^l zAo8O$xo-kgmwq9FzvQ+uydP$U`u_ckZjWN^;3_fqEF^3URd5*6(0&NvtH;#zLHhUD z0r>k|eB}ZZzX51j)xfw#gIWNC&05o6C`R=Vz!rnO=8xXc^xgfx3xM#iV{l=@3D*MV zc9e<*;BzV1Si>#sJB~0rFiS258&Gl_t+U^e(dS_fR)A760Narr*F&j8M(?Ty;xHbj07DFapn&ZF z^zoFJ+CG0?6%45jP}N1~a@T?l<2;^yJ=N!Jb4$O#%=wxryt5iA<35byOODEUMMqmS z%hU0vm2RijdZ@`AnnijldT$J&SH;EiFu)oZowV#vv90i^iS9UoDpDOoK87klVjy&j z{82HLnnYGqL{?;wC&aSPPMHi2@% z0O(=Sv?5CZ?m1X<8aM?l07LaUq;f?1>9#5HP4=1g##m8H$}ly02pm79VGk1#68lRf)6+s#EkTkG_|$aaXpbbOi{wGU9$+k z3desohCklspa+_Qg-D5WpeUQ=D-Kb#Fn+^W>-5ye?veOft9FE!Wv|RqFpL(#C`i}A z*?9@R4rZzwo%N;=nwFwK^#@~&mIPFa8x)7J)gj~r=D`lswSYVW<~KgB>Gp>e>Rb#d zW;5~|8x4RXa)S^wM~%xLXSE%;6qk*S4Kujd!O%hRNF5KRGd0x;CsZ-;`R0L=Q~;Qg z8M!kb(ra{hOO8rLf_}$BdkW>dI!+%A#?-i&)ncmI@Zy)@oCZK~J{R-D0z54~OJUOJ zZN17@JA1dV*b48STLOiXnY)boEOdGr)2$DM)qJe?_)xE0qoQ(u|07yluq|#hJvb}G zhWdRGtrN;_tP{?yDFC|3mxAS6GRo!cvr_G|Jo~Og=gI|l!GRR~%>cx2H@!sYdw_%9 zZEI^2LcwYZtnzGBRFnhKB>TL8dnIM_w}RDIfUGC;|CmyaTACj5QriaL_1wyYO{g&bmq~MCmht9r68h1az$vRJ95hJ*vNj951_jf z!VMv1);&vYT*N97()K?0Os)8&@kQhOtKn~Af7>mpY>sJm!MZwOyx?2RyC$nJ) z#|RXr0VKqGut#J<<|xzNbIdC#!kCxu%myzE0LCx@9?LIM*c5i*LID8Wf;AY0u|N0+ z3!S2jQN|cvg5yZ<;R!@8B2l5k2f@pu>KG_I@BI@OU<jUVOI^72((B6L1GDi#G5(l7j2ap&Kw7O~sU!I!pv_x`;H0Tm*QNyJemk%RHNAv9m(dy5I{Jp)uy%o!098n-ksI>BGpk zphEL8zZ_yR0gITsiDX|)Mv!DJIKa!Ah}sYXf!!PDm87Ah`zoUE?+ zZBwJwUK8s(7{k+vD&JCfVE_KJ#1~((#CP%lG44l41HlIbkxLxMP&wt}fx(Md(#!iF z;T{vzL+fz&UFid2+2alV>Q#XbYc6aiz!sJ5TCjiJ6%i12kO;V2L?oAhntlf*wZ_W_ zn3SRi!=S69OhI1W6x0?rT*~SG&-T~}`C;4bY{DPZ?(Y3QJ$rJRdC~)|AIq;5BezYI z;GdTV+rt6_O}p9iY&f|=cz)q}2;*mZwcyu4gaJxAG{kR(Bsm%2c`DV#s=yvK4cMd&zw;(^DPO+KL5gwr@IWoZJ_8_noj%n!bVk=n<46uX48eZ`d(HRA9mf|wM+0nZ9RB!Db@gTIGgVtD9M4n@iHe6&A#eF z^NX6{>m0|PWO%~0q;&bJtE`gBQS8018?R{Si^cHhUgMc`@7`?s zR`Ingx36tmh2eX^A1xK8MDtN+k#wnZe6Y?M2U~65y-g6e$M*h=yV!gaU-vE~ zCq9@PUcG($N%9__pCcnO^0yUUt?}pJM%+Zs7G0w&{y?Ry+-yvfL&Z zlgHhC!|`1BvDu2*jCD)qK{x2E7Y64fPCpYU&Pd{R@+6cC?Xcuse~fFc@Rm3z59{jA zgKjyccjQRrksj9gA*O?<{WLfaF)&`h9L^u25X@N=o9e!?#=}-;EtB?ZArZFOo4%X> ziY8IZjcai~w-lqJD)qfK_3GzVv4M`SUyIo}A6?}UzMsvk*7oZ=GHp1;hl=!=iAcHx*sp`ZC2$wq*GfW=`*gjiF*uYw6eS$ zC!v(n6FUb&HA=x(W)dq_tg!oZOUQr7fA<53LC@lke!|!Mza|+=JrfVC`(-_ekGpsG zZvLG;>%7KgFBM11cK9weIA>)B2?*A&Sv;xcu<=9G349^NpB0ALe-E*<3^SSbX5v#Q z3lG+uWbC{rEu(YyL2e$>|d~DIT>>r1ibb2$VJjVw^tb?SWC`4p9 zDQa~>gN1jVO~e`PY4rq^l(uU>jz0D;c&@_fMX1%bRcN`|XKljnmQzqD06Puu1~Wl4 zTqFp@GtwD?92Lz3KDrQ8Ddeh&>e|{XN!P;fg3PS;pyn=60@QXBDR=~=W&FV;7XQRo zoM<`_UkmpaRb(MxD|o-Jne<3jYGrj+H@dOoiO}aT-MYZTv7p2O6oR&%umy(g_0$cLFwgur>B8Wj%2efU^6ww-@n z*$#5Jw_WP#U8Lk=MYFZ`%A4KnExsdd8ICRI<~-Z=#Y68R&!orugju}m(9u1)tQ)@- z&c$IwzQlNvFE`c?lJ9tGcw ziScqi@pDt0T^0t2^r1MS#;^12 z(&{aCN+)eDLXCu7gM|3voKkj0s=B(a!`ekbgdlEM#4VPZo*uAm)hCZ-BfN|WFR&?Y zRhqWW@lCp>Cy0=4Es~-x!B9$mb)$7w-!FkH+vhM|R0Zd>;>*PDFJ*6mP+-Bl_yg;V zt+zvbsFaJ7)zeKe&rdbkdrC_rA`dcNyz>{UgB-u>srbA)d+7a>Fs{_SP&1$GV$G}* z-00ccFBm%|C~9pMTWvYB1D#NEp-UG1Jt`6C$n_TE%De$J@yRd2Qs)qt0D842?W)~Y zb3~;B3d8U6=3>bf8@VT>SlO$t$1C2Jnz9}8`C9@rC`eHf zgKrBqtnjrmQok%-d{ReCQ~FA$L`9D?H%FJ4eaw-@tz66ks^&f2oOpOrTfY}IpFR@o z?Hep%%%U2YclHsVmC>BqI-i8hA-~hj$98jR3H~-xDD<}X>Xkh<#I!T`QS0T&k+`eX zM=ad@9!FPCZ>g7P@9r+O-sF0f^_yLbwu;<(?u&mVX}r!;J+ncb#jj#&;&5^J74=!U z&pxtxCn^1efZECp3QOU1U^|!PS za2o*WO1?!_W}HRdc0+^QVz2KCnsoo&#~-J{BwZZ*vC+s#dY@Flmt|Nv1Q6E^8Hs1@ zy?EK)Ck3(ce6>EMzawl;;we7ORsMRM^K2HXvphpN8H2 z1OJ0znL8KjDa&SD`o+mVAYk|*;~bYc+IgCRz8w3+{`Q7+*}GCS%TZtM<;3c!;uoMD zGJ%NFit7dLHGYNm(Y?kIky#)OCOZqChkgY0ge;!k^>rU}l*1^jN{VL7L^fH}RV-tbY-gtL`usX|GI98d0jx+|s@(-}{ z^%dm(xtw(V`!agcsG0ykx>%}TzkJ#6!v|f2E25g=?1RIu23ZUJHaMq^u(|l_UD~#) z0DQD$3}Tc9-%4pXF=ng3uF{AuS**??{Y~i>z8jbwj+5gqe$}kR(m;>_pN#ZOa&pf# zSo`s7H=h+t;d>vXBz*Mz-HHxi5LnB$dwbU^Fej0^>-OyhYFuE102DK=nm!0Q7&I`o zCc?U53K6I`q@e|-B@kx1q<*&x%U@QeVQehGK#b=H?T$t;DQ0sPn4o0LN5N9?Xw569 zhl@SX#H(XN)AF0`gQEpYceZ@Te_Vi=1+d9#2ix}H!-tG2<=J=9qI#L6i27rGfk2P~ z-5js`|NBdvbdniYy*E4o#)KwpmZ~S?;+zDG1KBeT=RZ0y53)Y!;Uu5$UGo#7KL6PU zGhg|BC7=QHNUm7y=x9!gb13V54L8bmFD5N-i#M0)7)eKQ|@_P>wTLF0_3 zx(6#(TB-*0oRklX78U%?rCYTq=3Fjq19iCj^J2;Se||Pki;Fq`U67D}_$~dMQ_`qI z9bsm)V@&|MUTJi_;8iXUR=yq?8H7F-CJ<;YsZV~fKx|~~wKAw)kK&i9??h=$6lS=U zYDT|atp22S>*JJ}r;+prN`QS*|Gz=dUv2u(pS<&amb9=Rhl|J_Hr{#vKEGMOl6e88 zQ%PXXGZ+M@oIkIM4FdWoMNEGF5W*{fkID`Ehrd*x`857H88a)#l0pjfwu9I!8;!E) zx;X|(M;7SAvh@4^zG>mf5ZY*ZiWE8Uqa3q~XFZ`r`NDl6&BYs-^u#R5<*Q|yuCWTx z+0B-+`J3h~F0=A~zon!q$iHM;ZmI4Lff@4gECwbDLf6V9fEd$M3WGpg2$T;vR_x{} zfO>Q(mkoHMM0)`AxFLE4l+il>?)1!3sQfUTKQ2Bl#C{ZVVMZ=%GJKDN5g`Ekm;0{(wk8J`aFK2wk1WV)YRoXjxPAZ0H?6*#@yFjJSg^oIE?;AOc1BMf!FeRx|%( z{*%-Cs{E7h++iT8qEIKa#BgILe`cz3GRjA>=+o-2xg=mt1K_p;vZz#w!}pU6@5h~= zIUCJTLUL#c9wkvTbZ=;f0I|#mzDBb)eLcy@;2Tq1>SCcY?`Gw{?}n#(fk{dUkU2~h zm>4MVfG3CI9JEYdG2Ez)89XHI8?eG`5`W(5zdv{MHO$(i*^JRRw*%ya5PvoU#tT31 z;I5&0J_6j_EU0nVA0V2&)tK2t3;%2)vszS%pm{3>E8{lIt(#?JW{Y!}zAaI=7l7p!-S9G#`%N)M(!slc(;OIhxI1yGQl#CJ~8m)psf|+HbmOT`0N=# z6rXPw3Mntq3rRphUqbiHp99T%;LoP`aCfdLM5ZXKNy!I8plz}HcivKp9EB4{uimy* zi*~HJ{eR20csbDi9c#{Vsh_ffaoEGeL=xhNMK4j`CTM-)L_TKjoU`>nRs~i@Ap%Ve z*NPQyqqv@y;9$XjW9FB!h#_UPwV6zSfq8%T=efdu&HtU~i--|)?HL{qLogr(e*ah4 zKu9!uCN^HcU=3}CzQQkmF3BzmkX+XPhUO-m?t(krccxAGjw;5EA?w4Y(vX|M?`f zKS^L{8>kk6Q%N95kju^ggn~}s!v%k>@#mU-yJ|BmUz-bV)* z987w>5>Vd)+oLn^^9T+K+U@@jpzYS)e9latl0@+WKV+rG*Z*_wOd> zi#{1wZ1KxC5m%sbGqC#W-dRr^%+45L;~mrNp|dPKw-$iBb-It`hdISfQeN5aoU7ZGsH z3&@G~V!mRL()Z<2DjJ!Bfmq8Tja2Gmwm+_S_lYnw^>1 z4$6FA{t5{muf%T`{JD0XBa3mh=henc2`>;z%XcU2KsuXc(6#UjyMcR0E8x6 zrZ?!;{BT#|PAM`GALo2qXC}@wIS(%z7f-hXf7dlvW0Z^7U{PTC-4oj+!P6Y5em7ZS zW(BWZV`U&!;J;`fYl3O38k2LATz-j>pLg1t5xLqk0cM1e99KrMR@TwQDx|ALTAU==kpb z;@=%H&P0I@)Aj%&Pxg;;Ukq^BdKAyVGV_YOOQ8G_;$pi~)BWT_)J{>5tsh)-Dl(B{ zl}LWRPY=ldIsF8dDjSo9HQ&JHziY$>_XP7Zv@=L@&(+O-w=ozz}Y4>zRNzs(Yn z`t#Z~)-L%3u5J-#!gyH5<^@jV)VvaP>9vz3UGZ>T$@}>6nf7#z z!??hq``zmCJT6c&p;?ZXNCq7dr>iQ);}|wUad`;^08~w-02J(LbGCSEST({ z1=~R)UWmi4d4K)k4%)ifrmyF#50P^Jmd})jyQil)xO>e%1zG%N!Rb-P+yr~#9*~s0 zX^tnDY;}OkRSffEi9e^xu5|ItiwaG)YgRykK~pf@j%$w(JT`v26#qqTex;dxnkv1p zj;`TTkhSltF6tZvlsY%lu%%4id}t|}hVO8mCHePk2FgW|HESN|UNDouUi7Q}^03wlqit?X*xolmv@8Zk*Jk``YQi;teZ9 z{_Lcy9)n-o!A55dD=9?L`M$BZRlSr$PjB-m~xd;%avD8k^#WHVnq&rA@@ zqryz%Zto6Z7B2rt%10zq&mS&K-aI;sU3SM z^*HC)X=OA_hj5F`c~^@7*|(oeGaEBfLBg-0dp`5WKd>IdO2p=I#x zajAc{9}E0R6c*CDpH;tWsbe620iHWiQ3ip}$TIA}I@@7SPlbz>osGe!-RDE`jwcs? zSQ?Sv#f<$55E+YwixXL^l(f!NTWSI$b5@A1Rmf{tE6EoEoO)>VdGUTgYklfP&BaG0 z56@lNFM}@RR8Gsfu#vZq5zMoXFO3=ffk(B@gMVjy<%T)SM?Hfy)w3HNi;N8#9k#A< zTMn58%9t6?Jg7~deE2(dKS6o`^3eeBZ*pgqhd6>M z6rX$krO0^j{gwK``6hb##dT&wKIh$qL>Dg<0Yt79Q~ga*WZn6Fua*kGV!X554Dj=w z$hpQ(TknPA4A{O3iV2TeT-D_CDo5girpPI#RkEAz)Q1Z(?HP1eI%PiRhJEN~tS)K0nPvk?UiUPcLWfWfYsgY840MqfDM$tB!;36>bk z3#)Bp3?gsXP6p<**7gh^aCkOh9J_y?U*K=gCR_cf-0iXV7P^l7>{*Lc1dXO{!adEp zh==lc<{lP_kLTM~-rFt2rMh;>e&ID&w&!;aqA(NYVk2V?I?><+%(`9qtlQOc0bbYr zxHvPouk){4PG|Ne4Zm^xuwT-C?7F*m?@8RAHS1K)Eh}*|mW4T6Io4ue8ogV4czLyp zVaSJf+nkmFj9G7fX7fhJVZPgy4+b*F<6=cStQ7iB-T5_DC;9lHbi&b13Z=LDMMld$ zP@X)HHV#!(D8yxuR>v0Rnu_x%*tVS5d_!hna3pPU^>4%8ZncX=X0qxqFEbcc5)wU8 z*4l2Bd^NZB=a%Z@R_Qmi8qyzZFd$@G{chEpqbuY1s*OY<&VNw6mwP@@G;4<#w@$*B zzP?@3d=jmIBbr0=y9yEEtEE7d1?w379{vT9k^X%%A1wL|f}*doT+vU6yI0cUmJnca zQh1r0h~9Iv0Ja5Ach}4gTrZ;^C#-(=7#|KkhES+84$r+l;?Ej$5_M7_3$umXfC#i0bqjxJy>lp+M&A!E)Gp~o2kZ9bf8@iU7_RM-9v>9EX>= z87z|Mvh))T5*QpAiHk5dOSx{f?wuS=8c_v2yt*hz6TKur=%Fpuhnlv@u*59JvYQH; zsYYx~(A7D)J*JwT1ApRc_n*9QUMTS}F!4UESci!1u{0}!(`L?dM+2Vo;_VsATxT?1 zv3H-UZE)+2duuXe4@bYH_J{+pI3n6L@NXg^Ae}ep4}AJGTOiEhzK0oTpl6QINkk zn7BBl7oB z0j1PQCruXwC%g>C>;@e^hMap140bI08JT_SI*1%^;#B0p284!CLnLDFvYXkVPwX?p zKPYhjLM|L%iMF2_T(lp zZn6aVKL!N{fO%MI!GUKER?hPM(q+h%(TBloXprn27}#S_FgZDSg75fVDw|_AnQi9V z2euk!i+qvlBEj$xfyOZG1;Go7I>pt=m1hPUtE~qmB2*}j5Nb&F^xPg1m zg-=}j*I#P?GIjRtI|H@@RuhAbhR3&l{yN=oPXLX7$3Od8TzXWgT+Af4cK3jTO2@td?G=r0M38`9*+4`e%uCj**b-|hj#_~ z6Hs8bf=q%Qf|deqkT-5sb{1AvF2F54@9&E=%RZm9h6XM2I}$KQ@vb1GKcn6t)s@XX zrQ>+{%TJz3J8&*Au*Nb8$P9=S)hxAOAS{rc z3~LGh20R&cG+FE5i3e4h?0DXo?9~*s5dk15fpc~^XVJp@wN@wektvy3Sqrfj@z>tZ zUEM>*mOVXX>ZQEYWOmI)IZm9IefvyTzkR*lqcVEYO`fG#0KhC-=&JwaVgZB%!)3%Q zh$p(pMuvD~Xf_^{!L8$=EB4#H6LV(IBK8cPDf>it!1cpV%IIW?+p(ZBrzg?X)rz^i zW5jb!HiJj$mGPtsZ7o2I3HdEz|%5ugm8Q9iF0;C z2L&Mxhy#SNU?tX_LgYjz%bcRuR2ECG2$^aTqCH;C`qYcTUYa7V+t%ZXn>Esz=evuf zbL+&ybHa?1w7tDwUUA%N4Cz*vro34S55_EMMUgzZ_%3NFGkp=qIdhaPxGottY5imM z2u&KM9JFPDOC8t~RAdG|rO?KW^C6OU4hjj`imu9sZKOM@Sl7`}f`&f8c5tx)&7zTu zajfp2KrlIRo`0d5p@g$vV8cxB>8OKyf&reYWyd*YKLiW(@YY}GacNQwo-`=Vn$T1L z&%pP~&${PAR^UV*1yd5f3gM8b1Koi~WEHnLQCy5cL4!l$*^P+mIfk?UtiAwN9}^|q zSgsn92%a69?7NUmvT(vueI-5z>KOVEpa9{QE}g{$_T}fyp~RGfsDl9*S(!u}lJvWS z*uuiW;|rV^;2Ux^q=5@2D8S2!T!Pnw_n+rGi-`+@^FLkcP%O9M%p2e_IuC{< zrVU8VR_Woz8Zcr|^J6iEG@h7_@M*z}=V5<^?kJA|+I14Sc~1@>B4sr0>%ccfxkx=Q zKobltwL`?vRVP-c-zJ7F_3b!-cfix{>oZV zNT5Xp77#Q&F>Vn1S;%XFnk;e~!O2K#!PQMyIm26+&}+cNY=6x~%?J=90E%*~kmCZo z_7(1`ya4~arMNnwt53|09V{I3tpua|2QFgn00@m5hZYILT?l5#TM};p)KLsTfYM|K z;P9@1QO}=tG7vt|h#KT92sAmrwYBw8s{v+#&}6VN$eR)#e5D(AwesQ1xkH)9zq?g1 zQ5G`AVkq|+3?9j&=XJhhM|OQvXcBZ7d65ZoHC(Q>OQr0nq)lD&-R2a3-30vr$b)Mt zXG9|w32*A!4kJ?7vvRO7k?9)H*CvS0d7xe- z(k%RY5+{Cd_C7T627?So+~Pt8N2Cr#&O&p9J6nQ|Wq}h`)b<9PI6u%g(1mI6;PVb^w&(5oGQJkZ2EE*~eQILrj|pi+apDhP^svdTsJCZ`SwV90N8s|X@`lJ-FQIZyLN zu=z2GB>HMrg;~lSjPNi}c@B({rX%=q)dw|r^MVB20?G@8gg{7H`Q@^ct&T|B4lq|) zvE|efmFWp7OuI~Q(}zhOgBE~{QP4U4Zjj?^J_jfe=3S&ZBmOxqnO%mAPWIjKGcd!& zjA%X!u;B^V4D@mP`ZkiN&;p*l5>eKtVUlg^GwFhxxUR|EO1sj+iyis>S?(k!=p6YZ zSqHVj9AXaF8j|B4F|;QH8}ZH@=ab-pjOi3N!*QnOgMq)9DsIUlgXng$R-GPr2}n)9 zSrlZm=npFYaRHW*#unf9(&`-!hyswH-7kAnWrR1fga?U6IYBrX@ZIu* z2%^eGAv$#aVS*Q|1s|3=} zIN6WO$u@b9wX^QLtsKp_);89SMKWEcTT}sIA7LT6Cbuz)LqLh=RL;wqTn!O<@+^g& zQq({n|FxI9-9EI3zH9OB-+pt8{cAZ%fC=~mL}0nB-7BcGPsrv}gI5r;{6qr|Po4DN z<04o?**EEh)lSeuz_#s`l@aEc5b9olgk=9>cg!9TqVwP-L`=?u@w()(Jmu<^<~#CP z{{3x$m(H$5Q0Ox(Kd2yPlZ7HF=W$URXQk302XZp$edvW=mpr!p_6HTTFu3K70hb4I zYC|Q5^v970t<4WykIGA&8N-bOeKsTWpk@`#u&FwaRq%Q1rH9N?aOEX z?jXhOp1(8KJC3}F046aZqySm23xrIk;)i=kLX1s;t_F;m-{rqP_j;U+F;vV-T~YDj zSz?y!uq>cnakE!!#7j>stE?=El(HZR){H6Fp+rrnnQ_aa07+`d6mIY4YlX#Eu@xzH z!+Uc%1ndFocU2L!Y5I?aC0=;jVD>6T?>ST4Ek^oh($ia={{}l063)AIPhVQT4L3(! zn@W_Ttx)N@`rAgZC+K5=SY@}426TK9%Q+a>crRzN=@5yI=|$p4JK%7cwtOTPqC7MQ zl)7-IWPgC+$QHYQtclnpf%$U0%TZUkL@uy`FjfNNo56_J&BdixZaZ4W%jDlL!{90= z!ibzcN{<$RBt^l3f^w9ME$)XXhTok8h!ltjkM?Lj#<&M^V&)@W!%O=%dg1htUbO(e z48OO&Qgg%gn|~pl&H&tUF4g1>m3`={J(WN+%^U#v2OpP%Csx18HFCCkA;PkhFOLJYyV)yM( zv4IoxpdtH1rx+5yh}m=yqe+bEh zSFfG}WoRCPwLes)JQN;j1H&+AA$IKXI9>LkQ(In6{M>=u4LjBB@-!T{-gmkjNMpuQ zd*HW>ebG#23>e7;zfh`DiIh!E$YdCL6d@dS|5Lvu z#5jq(Kq&3Q3}qQ|FA3$SfG~%z5Pbuw^eI87Xm5-+8+MMu6`+H>D&9>C$T^rK?b`bt z@}~|cwxLUWyG!wJb?c$8j@@iIhXd`IN!iJ;OuzUQT2?aLkjd_urek9FkJHd0cO?O6 z0e{f%!$!`h#0q`(Qb@_jT-~A3_E|eJio;R8F`4Fv@H1-1vugnWA|Eg0?mLwWLO&j& zgb8v4Y6-B&8g@21U8TVjw)9G9w@?m&)P)nP0AX6A-Pk9vzD|@)qfnKAnN4>0)L6#? z_{=Q_MGS1LLQEsc4Or1QPZzZ%Sp?(Gy4rEH&}8?D=vCG241R1Ood^MH|e=5Xrqdg;=efA@%CCE+&~SU!&G zwPx=aV(+>6a@&PE92fe@LAjQcGjgNm*Ow2=uuCECr(%|}{@7{n>`tz#%%0+Mx-|k{ z%O3;NA|g7kc^C&)4cH!N%fIi84O6h$@H@?Zav($U^hn^CS3c1 z`fC;zzx$FF9%hp{m>#-4p!$##C|O+NQU7J=V4s{A4W~DNch4}XEw_PeZ)~IyYT(_$ zrb$mWz4$(xgrPW6G~9*K(zQh9F|r}NC&^?UlMO2D-~?%#ssukfEi~%@6rem7$Myqm zR<#+}YcUcjW3%?|+vsW-)M#QiW&HnM^Cjb?0SEs6L`nJV+qb<&4pUeJo9GO{P>f9B z-qb;F8iu21K*7WRwZU1P;%K)U5F|O*UY^}I<*L6jOEw>rWt4oA$*&)bTbcI4Rqmux zy8Z?lHNuOJAJlz-aby@O?(*$G)LILRcdlFIeG?zqZ*k@>bVnK;Q`|(s(bzPFQ=$%{G~Ir#EBG!{P$d+-ra5dXFoej53NnO3DBdq(kOJ#3ELh^%5S|WC~0Uk4ON*OXj8c zOi$^S%)^!6!l;Ca_R$VArB`T1$acaU7if}aQuIQ)IF|Mdq`>o=e5NPgYa)cCmRgr} zeCnEV%yugH(E4vZ-oM0j%l6tsqbAc)y9#`}bBfodD9>}n-= zHV?^0|J@kjl=dMf%-||c3Q?H+i_GqB*h|DS^zWJm!9nexcX}IqSO$O>7h|-;jKkk> zV+n++4O;>gJey4>!T@?bf$=;18kNWgPfS0Jgy02uQO$j+bCuyhPb_2!cpbj@`DQ(T zR%ojYXbPBp$#2maJu>xk8F4J}IyHcQ{A&yR3H|I-Yp0XEX!6jj!n|07ue$ycU|9Ov zC;^J_BxLqZO@y4&XExM-pZ>{AhpQsGlJ{0dj*cm{o#<)F4-wLlLbAgLBL%X{j`WYl zg@^$poCl&#Z-S^&Xq%p7MK-%O+7fGZWtfuLv0Dyhk8w}KTd7JDRHbNY*(fr=_;wLy z4UgM5VN`+>9e@c5Wj8R$VP?ZVq)>keW@K&HZY5Bm)A@#%EE(z7Wx1>$>2JP>rkhdD zxf=P1D9eC0cI}dPYPRipE|=w_u)n3^eJqgH`5)W+*IkzSoeB9DFq-G^w51yIG%go+ z{;H-u_;IPy@OvEsEy$BxkJo^>!>~DOXnNLsSawB1qwip6$Vxed=B0<5W zm>j4moKyXS1uw*){5!7ay{MI>csV2fP4&{@1VwlvzXriX0&W}>M9|?DhYM>YV`UKq zOYBZ%yA{&xgqkqa?~W+goUPB3pFo1HJd& zY>@{D17!K>l8Lf16j_A|SV*1k>2ze#tJ2+&hX{nTdAr*JRAbbR>Ox#?c+cndu4QI` z;m8YUxDKXyR4>5!)C}}#)W4~}!VvQS=4TxK00}SLM=yBKXJg9)t%{shh)~ZUIpZN? zk2z>_kbC16aHBn!MFg^Wb{d_AJG|YqCb4W09{lWN(QXm_j)AJkQcB#^ zx}+#_vctwh(cqebeqeU$&When0P;Sj+J`2eiCYyF#7Csl@twzRT)U57P?_?szSX6bPr=b{oJy8%hd29SuhF%vy zhOP4T2#KcGb*Cw#!{X*UFpYL#D0!$ZR#Xgtf?#``*>mbwXM!@_1p;h{kS*Ku*)S<1 zv`?MDlGWM`^%=H{TqYF;OQ2dBSJt#uvK41BeO1fzkO{4@Uo=_$pPB ziY6V+S!~=`v|9_PR-y0}TnqwK3|~`Zn$f|~#E16HNSep7R~=z|MllkJ2$x>?Hs3lf z^Y|O`P8}?rkxF0hOxUe@(=c7X@4f3$nJ0*(H?`g}$|t{|3>n^7+6X$;6J}`;oA4e@ zQuMm+JPnmZm#>h}2||($i#xdB6Zerncb@sn46Ko6=3TG zhNK%iCP^W{AZ206F=c%U*_nrOPCtADb~vbq1YM+aMFl`L}1u zAnJ9Q#XMX(GKz|g-D&)&Q0Ktb>%;?Zzp99*^@_VsE4Q}uK05VDz*!2HX3Pe0qC~#O z3O7tw*VS1{C&&~^V8TVSL(K8wS<5rXs2Azz2R8I4G)}%ysiW7wfHK83GR4wF=dO@Aq*Sd2#lZnmeTCcl;2?Ikahg+1x)W zgZpBhwafzm4Lm(Ol(o>|79ttlEd~=rLO%h_koZDoG=jc5ZhCF4Ny zlYw&<531?TA@_MB$rek%{9&j@^=GdH?hwD%{HN#V(admGDZ3?XydNKadCRI0ov8Ec z(^Oc_i@N2FL{CmVUVavp4SBF5BrCXgqL^86Bl_-^o6RZ}?;^A4)i)peCYBSCi>WT8 za_mHmM_Wzz2Bj;WJLLAYCNit9*P~{izOmwp03J7tTu!)*?3R3;BXvUY!hv-~Rd+QM zhnF*3{M_+v$Dy|`KYnnDNl-h<+c#M0Gqo6H02+d>tF2+d!QeA8Q*J$8@V?uWql$8}yTEWx7m8BgtS4eydXwC&&niu2W;`Op!smJ-)&BE}!5puKB z$T8{De3j}Jm;150t41YK>us(iuJ7kOx@fVdhXh}U4BuN5@isydK^H-h5DYM`rl$j@ ztPThWyL*r@!&03yHoDxO@8%Y%u*3dyB}QE2JVX}{fsrOGEnSj@u8K$9u zDGJ=(ZW?A2Vdw^_7(#ZklP=Glp0u9;V3H<1iAvbnp#_!*bUhD6WpXh>8CK0}si3iY zcWAl7&+I-IRwwSCceWQhx2qS|d~)?z&9wbPZSCP$7a6P90{7=caTvcYYEk}$_5?(v z6q|ZUvPY(T%4v{pu|52-|2^1kCazb6cZ&7!5%vSz+RQz4#Ya#O2*paHEM+H$pVCj?s-v&-Xytx^D?I` z{Z{2L&*Fgk8Drw8z^9-$U|3A*9Oy|HQxEF(UCV^cyPeO02##49p*t8b>$ZOR{JBnP z1(ck#Ff}2lg+L5InnA{!`nHCJC-&WMytO@69eR**)pv$;XsVXFJX-1UT(OMV*+%7L zcmG6sF;XeXod7YC*?7*4|Ca3XKmTA{9}GzwftXs2sAI{o$QO=?Iw!I(B+7+)P4WyK zqPY?v6LQ!Q^d7t0yxG+nAGi*V+kP-GCKv+uA!V1JF-@zyqvl5rp`QSBx>JRgHHyi7 zZ&T)C0?(;aZYYXDs{w@esiYGiO0*z(or8_G5)S^9XQ{Cn#ONy7ZNM1RiVmE>m>yaC z7Alj;?38~hi5!{WhD0t-DX6)#UcPv-g1Sf;GSn6dc3(W*RV6%Lg?r3D57iwRAxm&F z{G*EkU{!UmXYl9GWOTJrLq}D+;Qvy-Zq-=!z{}L00`09^XN?_U`-Y;ZDN&-gcgm3k zke78y*8i;K;|Y0BZ*X$jF&#ij^*}?my}v1};=Qd!&(ly@=pnL+hVMO0E5@=8eY{<3~zp0V* zk+}QUl{_Q~GC`>#w`DLcm2fT!`8cEG!jCAPvm<7`{Q>yVlalzmyAsT|^NMf&!s`5Z zy)w+?)%k_aEGOX63!XjQ;h}pXh__bXjoShf{QH-8Fv|UceXy<|rPEG7I0aNV+N$eB z5QvRr`;9p;0cOq_4WLugMM$8<(=|X{Tg2q#cz{|F@C+v)->+Wp8glY^F_@yuBs5_9 z1$)NW8+#LU%^?Mo>BcqG*Z)6<4}-4WNx$XIZ>xK7LY zNx3{qH*b!hj6Yi;<94R=!Ks^DR8X4Gg&x>{`TgNs%~$q#%IQ3d-eT{YnCU8a0biH6 z_h`g%_KK~vdI5r)VW6J2ukufcEEmcz&l3FM5j1IZ=LsMs5pi)Y^dR;wFBEUZayIV0 zySI%l&j5lx3osga%>u#5D4fjTEk`#`HmY)7<8*f_Z|ThC!uHcsxSn9EKR+)qjbBxUUj-yQaXJkNQQ(;pqNL5VTusO!eAo54T<084 z-uFK|&wAFn*L~k>hNscce;EYt-@hMqa=c6M`l!A(h`ZNN#vw=jIK(-98{%UJ987u_I;*#NeK+}ASVpz0qS4nR1wZ@TqQB| zY|Ek%wuKDd7~Z)h1?{x!>x8Y)5N-z^r)|ZrZ05{PF!;{9rfW;X7w8l)8d911E2En4 zDMm+h`tM0u7SS(u#o1wY+m8SZQ%2(gn>MuvI_`~+q>huu14Wl<-11>)3$ghzM>((^#nyBRMzHgY}mV@ete z&cDGM=u-1aWpZgg0`PvS4^2$c%Yn^yXx)M_6q&M!EjwgdMKSDOf7Jp z`x6x>$FKvdX39K!B+6t6Vz=9so(y&f|4wsSOpSkY!Ju5>R>%|N=p(0O0=uAlGNOV3 z%`#3xpf{l-$dnOw%c#&)7zv#T=B#@vQnuf1+}9Q}VnznTD7ULF2JR!2knME1&e*uX_@nV)8vNk9!5Do z6G;Fh(yE^ch(7AfaGSzoUFZ0l0n_=CBc?-p|JDWj+M&FI<%HEHTjqt^i+BiI2rYs9X zh7@B7eNE3v7M?Gjxmgk;HvIU|Ub3MZzrHnN7N}y&Ed{J%AO{DiA*GqAb?W{5G}i=E zx(ats7=mpTjQoKN9hYN7?{pZh$6)T2qfM&c7PB? zIt=vgM_5Wc%A8htzExhFnF4sSn~WJF!BVWd<(8M|(GLyS)Nk&D&~a&=$y3IXoqJ?< zJ2yA5J6DN+u?A*`oINMb!R;M(0c=km!W@(J>qjt;I69CP#z_{P0`z%w=o7%>9rDOV ze_u2S>ZK5l#Pd()-wHW`wFVImBCX7Vp}6m`E`R^-f0srf6mARaC_cOLIsmDH0W%Ce^a61P#T4QW=GQ}f$5(Cy zf|EB*8K^;gqgBXPY{nRjI+~z*_CXA+M>c&$q;9f29dye_2m=uMc z6BGT99I;xP*FxQ}t;x3Ld6CKIjv2(+L9}g4m|1@B?%h#z$PBKbO5&rX!^0bj%7VqU zLHAgL+UHXQlT;qMP`Gt;Le2@19D6>c8>7wvyAIPhFQ8<~_}TskPt?pA7$nDD_GCRS z9v&d`0I5?UZZ{HgGY$)QEApdH_z<6TpUg2?p z+l3)oYMFIS5?n_CF;FPd^g?)U+|~GhdP5iIixX!yRc?fZRvgioK6pHc;?5uv{k33F zJ@NBs)uzoBS~x;&*3hWKIRJs8(07yB`kZHOzAyxE(v|xG{mv-;8}myh7WF#t<+SQUD~o9x5%XjSD8FG%ZI&r3&xjQ`UTw3`VUo`KNmP%kc@#A|#hU|9h=Is^>K5*uP zklIm!bl#KoFB3d;(H!KD+rZUKcq3w42?2e!yPKOrf!`*v+-$*uKL4SdJ2^U5<{S#C z%6jJ3jF13=4uf8pYO=8U^^>$_{p6l)^%F;R1>{y3T=hAj*-%yY&a*cW%GEMtH>`48 zmVcje;J^Xy#zJls)-^Xu=0Uhj^&s8l*|btq+X>#qRzaq%DsL96SMvAzbw~FP+?lFQ z_2ahGzhBE!!(5?IaPh8os4%SiIj(9z%s|k91OOgyx5fi=?yR3} zZ*Q#?L;nI&yy@Btc!6q))_*GBGkD*ztGc`TT0l!QW}9$v)C(59&1lz0_hDh{e`}@? zx4FW?77(V1uO>Ko0u?YmtaQZmVjgY#_6KM6(NOL``#o%Z{6M)&E-~*XYl8*MTS_mR zxv7Evo*>KSKD18VtoCMsSHK&naLiL(|9gyOcJM+L+K6TNT z4p2=bo`eSPymn@iPUW%BXFw}B=dK=Q*gd&B$^zGJ!%`=*G(e+^eeD}2_#V!BwzPhc z!=+Opl-{^d24C;tc&xeASSm|=KgG?H_6r_0aHAX1;w4F>Daysn=v%wP^-;0Xu_uXM z9*Hd`PX*n}cmiTV)2B#s%%;|PczdV*H{me!bZ%Ytg=Ni-;*Wox4^Vyi2kKyQa+mha z7tVFSw3@Pkh3VlGzh>2{Cx!)BadLW`c@C|YO5|+d;m@PdxeZVqhwO$ay8Pyw8bRaX zJ`n(6;@X-NBf|!qD7NV-6>b3y4g9%G+xP4LmC_IikmP8TMOmIh=5eymswH z{`$$24`lx2W9U3b724078F8z-Qb`qU)jvkX{1wdP##?XC($SSySJ|3u@{iN|cJ^|d z5UU@J{c7f#g#}%nbh=tpP%w7u@2l_jcv*%3BVrCia8_zg(7{?Nez2Vipo@hTI_fMMn+lLWokQm{ zU%y$Q;_ABDKXBEBR)d3%T$-y>8pxW*lVJ<+Ap&)5zmCT^3(Sy*43o|Mknx6Z}2NWIyQ! zSxuR*n$uXDl{?d<*3{b|RB5FEP@?rv;GnJKzQx0&7>z``&6(4^?$|po zN}QxK@8!b|eutayGIv6s5WO|0a2kqU?k7AwwlW8Sv)h2yA8bYj_~0h$zkTGlV=ji9 zMlpWRs!WaLPxMv8s34UkL&J~+g>akw-NGu8HF}j9gQywDk1$uO(pR%Stma#P%B4Ze z_ar`kv9(3$;=k}e*|v<_hIYgFP~U?60gnkBrFHLEkG=YEaXPe#6*cJ(AMVL-B2Rh6f7$oN8NN3-gChbQjmbXJC(=JJ;edMG+x_qPVz_NAyS1l(s zNT7UuRHKpm0@rD~2DxCTGNQ$mYE*COE@`YV1dH6l6SK%kY5g9)zlabqXRk|IdFM7h z?b`U>nPh=*ha?ki_0@6s0W<`pY7Cz|%G1pRbSIn9h)~~A)a}hy;;8;7X&Wn>fU1}@AY<=c27Qlu_?=?>ew#| ziMm*%tmzWd1P{3AeqofH5Ii#)rx%o=```Y*s^FrL6~l@aVH0-v{Jm_!?|L>t4BmN< z#V$Rr4CLCbgOjPZiq=E=6s&-SHUx;}hD%7G4EOd?@l-_ga$eN&>C1q(eY$xczG<*; zM|_=8W>)t-AV9HQ9+sn*HV^f0+96H7rAy}&s&$j_^wH6*k zp6#cv$s>_{9iDDmXl`|Z#mAe7^6*Js);4COrrwS=dJnKOCrukP|B$b5v&6VI54GF* zf?(D?;khf>+N8SPpHJt^R8Mhe{M%Wd_%Y}3i>`Nfu_JCeo`2G42|IIv&Vf??u~ypoyJIKh!P#qg z6t3RQZ7-+lm6xh!?ay_zv1zjP_KMV3l$L>4ZVUL6=%Iw z6*`rQ@g@ApQ&D{`aoC=n`G5bTsGc`@{NBkST`$Cs&Q5X(@d|FO?`3x+_qt}buOAORqIJ1wZE;1Q&g`oAii+i}7pi5;z>gfUF@BOWb?sWU%DB^et{1AB zEDQbF?Z}ZM$9fJ8`BAW6Bgb`}(}|dqY&>^**2PFlB3YKtEK{dZHcV^LjE z+d*y<_i^AjN-3e&6H%QLvIkRtnA#t0C54(`%)nbGrbGd~&%^PgD`g3Lo;E?|m6qw< z(iLMSUQoRJ*?oP5QTBb;&jnNM?W6VHsku~NANzXZkdEoyO6}mxhFR{rtD3#Bt6rc+ z#q8j3-LlUjuJm7@J#*&F;1@Qo)hEKN1HPw***lKe?j=q|jV`Ts(ZDk6k(a}@1P!qB7q$gO5?S0Saqp5j8m0VuPr9@$w49gf30c`sx zmbR|7wH^9$ug~4#1J0Y7&c)dM8+uF`BnmBhRAWJ4Wbi0mBT`XaPahtG#~CnIQ9Rg1 zCkxE?^{t6uq9^nSNbL z#$ID#oN-Aj5kbV&F?sN@Fnt)+7hJ=4?-shNr}i3SDE)^p$<#d{XCtE?!N zITvKbbeBr*4Kg*&aOIHD>fO5;4eH3qNG8hHC3pV@g=zcLqMa4Gjc2YYP6@&gX z3#qXu*!RO8Mc`z<7I9Y}eH&9#?Fw#<`t*-`XK7lHFOQknJY`qMl2vnI9Y#SbWlLq|kHDZ?(hcuJMb6l`Vl9gpUeNN4~tB(ur%40<~w) zyBQj-Rcuon9DRL!{KD-I_6Cu{PKfe)8*?@wazY`Qevtn&dlCdJ2% zKEF&D40ynqEQ4(qzPuV_Xr-w+u&;KUk57b$Yt{!tgq)pfJs+X_Q3kQ%4;h+jYUZC} zv&dN7-Ho+1HBIDwn-+dTry!Ivt`TYP_}R1jXO0TuVZe}cQ9g_$R@mYQK>VEdIUED8F_Lw!Y62R`%!d)q-)GC_zYt zc?*bsZp$n1|KX(kvV#J5j2L0R$UX)T0eRLl3fI}g9fSTI19<}3^Nuung5gQofu?`QJm(2wCtNe5F70=!`GtJo4dE`1Dx`5<*r^3QQDC+4o{k!Xc6S*jB`H<-i zl}})J?4*Oe|GO|E?#Hhz?kvMizF*VZ9A|)P!vp?G2<|cC}f<) z+P^CxW9<03a9vh=)yI!lJDcOJ3kkgUJ}V4GW@ zr6-wRg+Lr7{K!*Ve0&}>k@Y=ysG3bw-mAo6$$Ppyb~P}aYy01Q2*Dri-PrWYxw*L_ zub#LaNNjFT)v7I{c|3x7hQgpS1VMr{(s97F>W=M}a5@h@b6<(eB{{oS4 zK_O!4dmb`1wMNZ8hn_Wgvvf3pxxooQfKQI^IRN?6)BAi@%r@C5A%Qa)nnS@)&;q(N zzP#|I^ypcNR)+_*SYKHxF?#MT{o}R-KLBuUJuYXcp}cv`H4`XoX$db6P-*+$U0^Z3mA@_P zVS8!m@Jfc9c<_HugN!C0K7KTgo+7<+`X`@j7eY&Fbi$L6u9cxM z;^G|H&k-Zo31d%=mwvwdy_M`G6%U|!X3YXPE9o1L=rsoEU1;*-SpDxoqdkEyA}zuNYEDJbOY414IP{$p$w@-WYj?&K2m5}S>F%!C zUm*;=W%iFmA)h|AZ~dbV;v-OQc7^B%yjzLS0090Chc>Y)h2C&V2THHCc0mp}X~i~Q zBd4;8X9G#o9z5_?vU_yE2#0px8F2uJPbkU~KN)DsN~^W_hF9WcrJdW>fy;WdNx8{l zwwayX;a4H5I{JHjzZ@O>^AZRumiPLMytIjRHBossMMT|aW&k7mCLO&0-@pMRyQVCE z9(Q9UbR_m7J4oiP@fdV@@3jkw$eW^!rMCB#5A#Ad8n?^}_2S{fOr*T`k_B+!59w_| zIM8En7lu)@)LKH2vfiR$2wbrPkdlx5zahnR?hxgg>vLd*J;VF-0jV{}y-2*saLAw* zPPUK1*dHR51Ioj~RtD39e^wOdvYmYV{1#+>`+uicU6oH; zMG_i3HqdqF^2Ac0cE2qs@a2+13zkOH`-gpyLRugSk#^DHQ-+~Uf(G4`X*hKJZoT;+ zpg-9YyIFcNpb;3$Y~p0({Dy1%Vz({6A-0W_PunNhZRXm$jA;joA3*_VOYvG17zH!s6rERkux zue^Cpx9MX;XNOq@Z6;CsV?D+yPr_}wxGe0?bV%l`Y(sPZ2A+$4X1~21dNHV**oX>D z)82xyDYpzmL@=TthxoH|v%QOnK?;`(L5c`Sj@aPs=~ zS$4_E$qkJgi$IE}v>o)MNrji;Mf!l!xqw0ptal(g`s`V0ACWR;0TF1p!xhDGB|q(!Vq%X>Ww zkJE^ks|X1(4o@r@i1ClP$7N)J6ZYK)2T5F0wmBdmAmihgFE6@v;6MA6iMgV8?{U`^ zijLlvrlTiaym)cC-|pT$d)|brS0cnzUi8EAi*a$uScso@%hV}F&RkE6pcOLi%h~8i zt*%_`KhE>!WzMZUBx4OB&P$%nfX^O66Dpk2C=wW((2gV1zUt_z^qC3e?(E$3VQU&I zuC6Tpjanfu1y6l49}5D6$YKY(W)(%bV!msj6Gsfy_8^YsZ*w?9rbg2F>BhiXA3$7d+$2ALw$Xr&4{wLvNPYu#~w)Oo@bb@i<8w~ zSowM(zg6(Y_E@{Q4jD3pF=k2c!rVBNY%dP^or=Nd*i5o(3M5DoZsRvvZ(5{Lp8=+_ z?#ZJLmwgV!>CpVj&|$-beaQK)=xpCC`Ni(A@Nj&0&RCZpGU=F9o+uB@Ey9tk?Lds6QE zO)NK_1O1=q^dfdFVSeRT+mkWIKePMN07GgZ9!@kkp2R*<@nZYf*Is(qO~VPM>M2L^ z_wWY%ZIxSU;M0I^p+k0h-yQDx{`1|Z+V=o$hJBBqB^lJIHVr*?X*YAwey0!$wy)ub zr&;X0J5cr8(9-zF;Uqxwn-yKG#+7Nhs>I@mf82fjTeGPJsz}&iQZU9K>k;3Yk*c=w zV~4|M7Zv-5g21u03f_d$Ol#*OA<4~%6??k4m)ltn6Vr^5R?{~=*!y_l2J<#5sZPqI ztCAbve{%L_zS}2anM+}WUEzwSU9>bqrbx()h?=9`i-OMLtdY5?X|!Yjw$3H-H&%6A z8v2+or$(Q)(a+~@hzg{z7y(eWKn@Z)tt7Z^>j`J3be0rvAU58C-kNji zhOUsiIF|65sY8ZP_{8JzZM1QVK~xksDgOs-tX|i~qO^ut);o=AemrhiaryjtT45W* zUmh=CT3PBUD(_E^kEcL=eUh+p5z@Xnm8E%@6YF`dijG_T&-``JWzuj@e9PE{dA|4Q zO$if;V@>h(b1=!lf`C<`N}73NgStY#4SvpFpFNkyK5jX2PL(c6>&n2_fj$xU>GLIV zP-FWg7IPA*xWzl(`q+9;mGD98i5e5hOJlZ)m`=cf(qEMbORBSQ$2hT^AS4-{ z!-HCghtn=ERA>8i$*HjvavXGXbNcc$)l1+KcKkgmGH=+FJs07=N$M`{Jv3~yhZ^S! zS%`xe7p8sL05iIjvXi@){DK14GVkp+C)z_pYZB#t#vmPVvM-enAy=9$|=X3`bgyn&&;cX8qYn)6G z>%d!0D-L$Q|NQy%@G8jJ3d5S}O9$YKi$qemzwlvX>`(r+>J+1D6-e^800zXPU3kc* z{&BMqxbT))!F5P+r9y;A`z(G*=&NeZEF6q>WvtAIu!VUu>hK*sgeffX;i-m(|9sls zJjQHPXj|1BII1#gLu!Z_?rjUw3uDOR#6D+R%Pz0N3Nm}(BLF;M&Qy*Kze+5~r@_5W zzPy|>C3x7B!3$s9M5%1IZlJTXJ~+wIRJ*<0PIf>}Z&@@;aAGtob^f}x!>g??0l^UtJRA3B8kG|u2L+Gwd z1UKvUaz{kLo8cWa^S|j&ta~`hX0-iS-a8+oU{{H*xo`Q)SoiighUCo8iMxEcc<-sF zoXQM)-z_{#{Eixab+HQ=nit`eY0JSxPT5~IBMbb+ao-nOtg`LM1I49%P|oA0Puo!r z8{#;KcT(kVet#C?M3;+uhp-6{SqEsJ%gV~ig^70?CX;n5b=&*;6@T;zA7%Q{J93p= zq!x+Wh34e)gRe7Bjrjo)?WcOSne7IU3F20EFN=y?aNs%bMph=O0pS@fCoL zvz>X1LOlj@&?^6$>LP7@O8nf})gNXH`%);J)Me(RC@p3^7Hbq^G@Ml2rlDGpH4io&rrD?T3#QCI0X zhLhS3{lfW3MAiiCm&gnwSw=?DUS~m%a;|jDorbfA@8gj_n{(|cxXgWp+UbPdoOs2F zHv`DD)7Lk*RuQ=mcS`ATWl;07_^MO^FWKrcTbndMxaXLBnR12(T=!V=2*grmzDM3D z?-|N!ae!!?<_;$sa`wRuVEb5%1&uCF0mrVRU{E&BXGR;Ym0pP+VNfQrMdCmm1x)He zkk@vN99ekfvEt9=c@sqM`2Ac>W&b`i;;h!RtaB43fz(+(K8@Egl<8sTmL`vmZYy8= z9DEM0pi9ZBj>}s3&r7}b>H8%!&4E3v?tm(VUm2R7p%oHS2z5+xVr8YxSa=q)sNTTX zG@&pTa|Ny)7#Nz|$Q3^tG;8NToTu3JX=~y{|+bsh;g?(%OarVkBWrcJF3l)y9zFTi}^C}J#jp!CCcoLWRG z58lp18()#cGLMVm{x%=`+e4GU*gb!Vw2Avar-~v7|2-e64H>!euyYjrWSh#gYBqr* zsxGlAo5j=8E;$a9lXYtX2}r1;NCle^6BrV5pweZLGuiVrSnA}2U%%b&uLav)Y*%=y zGJr%PA{;_-UchHHWa8W(mgicSs9rEqi2WqAD6ndtkT8bDW|ib|By8=Y*F8KR5g@@E zWcn2?b`fHw4Uz|jaP=48BNLZ^fTP=N(Ji*HK2E)>P@1pd*f!TKpL|1xGjkztxZP+& z<=bZ>?bgAsR@DOwOTriJR5`6?dF6Z5qvw6TQZM-W!EmZWe1!5ATsBDY=@amA)(+CN zfxS2TMEFKUM6^;Q;jLk%-qh0zAgzf450s9vFL=gU3IT7Amg74#2?XhA97$81QR~Vw zry3Tbv~Q1#LBd@TAV!{{LEi&=s$7yTB4Zx3X|VgFQT zlsHFOZd`vJ_;o7jwGaR8OO^S#bgIsQx?a-~*TiN_nK`o$|7h#>?c1ptv+`;P42>1< z7{jn=X(z(z@^{ykqP+lWSP8 z!`D~V+dGn~39sXZJ3|+`{rdH6-k-sh`7E8ji~<>v__KmKTlLolvd%UNZ@w|(>5H-x zLasXx@py{*@$&3X;L{@eU~(Kfr?$9jGppDV#b`4PZyE&Kr5Ba45iNgRulVJ8`yOpj zT~lPYrho6YO%sdfIqkMxcHA?=bDpzvGX-kO*BK{UsdUJ1P6cLrFhylX;2qfd3OtGz zW-JYM%-o3G<8pJAhh#Nk>~c6MaPQs|6E7#xJQNvbtGdLl!7l0q9^~E)SvcCU)^w9d zG5!*FEj$oXVzdkley4tt!4;vQP64VN$I^3zdx#$rxz(wEvPstz!-J1yKEvQ(`Mc7R z64!xM7h_3W)+xm^@Dw9-xQ@wNnHi}XorlY)NH(oM%B4S)%74j3S|`A7nygz`rG?KJFI6{MR9o6 zQ2^g}Nm$3hdA+K91`DGR8UpukYF~Sn7|efgs9jd*^T7Ez*`?MU5^z2DvatEb-6}mS zFZAKdmx*_V95c<$o6Xx-bpE|}mPJCc|B9NA*|Ax*&m(kbGHhJyM>n*4m9pjwN)6slU8b(bn7o)1c`Cw|L#fi7gBol(krGhb}n4+p&EiLS>c6M zsKL)98*A%J;a{_6n_i=zF@(O9E`XQ zUvf2Hfyq$FJ$LjC^~HJGXwU`|7jqrg>oe7{RHftVaiQpGzK{D~t%99qPM`k#{Vy>> zW%d^w`?^myd|E&z{AXlC7sY)=pZxGSukT z*Lw3G24{Y$Br-I6V_WxZcj^!LHlWf^EH@uD+BmEDg4ncSohhbyWWaVk!szjJq53s9 zdVYRru-eSvUQ@ss^{&pcn^7Q7lr-SbAP=<_U!HAZ^+qPrc@t^pZ(T-WE!FTu)uSL7 zl_0`9!3iADCawB(bmgh6Qv1sa8RI3nt|+>wOyRJf_@@$NmYQ)F)>&$_aSXMB^|h|? z*&6HLUdLtiRq*oUPRHZ2olQ6!TS;v&e}35L^aQ`5D<38v+=%r4?CcxY?_JF)P_@mv z6-l!!&}zoDV?Gg1ct-mmwN1{LGrrNVwdH4FGu%#1wH^NR%SF-XwTBgRJ1c9dq=ts; z<%4uFqj~%Jb5C3hbl5B2ybjeNi%-Y`&gjn^J(=@Z*9%vjy*$8>n3!?+q)w&VY`o?+ zY~VJWSs8gXxadtr+%ttnt10&8&D`DH$$>O!HlJzZ`|+MPG>v@>CnkBHMuokDAka9- zN?Uxw=FXmaZdPArKlV~IRv2psSlT!)=oHmz&#~R@I(F<0o5U0w6IH|I5wuPAKfCG~ zrRXZw2S>}`Q0xHBZOqVcfcoC#>DqE&aSKUEJ5FuD$Y^0eE`y3rU5xp-`#>vW3QHd} zP?nNmsA!qfS!#)B|NQ(c`>9iVu$YpF@eLGAyYC0z61s))#j1mSXK2glpS&Hbf^&b7 za`>Pco1$n%%Q~%1%NB`)E?FNRX%8gbR3V2p36W?OkB&?(+SAGy0=6%;^;E-_q2{|< z1Bq$s>rX-{6!-E`P#hR?Q-vdC0)XIXw?*q-4q5>mgz%)tn$pi2%6DO6Vn)ehR#RPd z2TY|WjhnK5m)HGR3Y4lvj88($ODor#%C@Z{i8{oax502$b9GrayRg$}#v=w_Jnh~C z&&TIwq%BSO8<6q(3SA0q+}*Vj7k<9dCM0j|51h(Wa7XpS^X8(WEA`q|K8;jJFJCq9 z=h@I0n}7Dd368=5pWNCy!2BeGtth7%F42eq|a~U`pT}z8mRad z4iYtwc=w?jBF@~T!r8`oKjxefvw;E0(x-m}l89eh5i@QE&=H7MaMGDXBPkXcdrd8< zi(*ZLO@Ht2_3V;sn^(A6X^ScUTP(xO!19Rs!G2RJ*%zMXckArQZ|-`mPvhaigH9Ju z8#;t4%e$4#C!rxK-s6$|_FnfSp3Y2I5p7vg#S-e;zrW3*8e$%Xv}4=^su!bYDsWtD zO~Y@j*i@Ke-!U76owtJ5m2TAZseXJhFyd zq=n&=oTK$z@2}U+e?Y?>0tKywo9;(_9^9Ee?wGcwuY-rj!*?a7cGTxSeEMfUyB|nw ziC?qnfNZwxn8_?A8 z2q?3gK7G#f3-hQZdf{GoN^kO`jBNMgI}G*O?dhSpOn3>?>+gQ1nf5yh6NoB@44V&> zP`MzhEGIjg?}@O#Jm+lrE9a0$K3ZVVopgVSYr|H&`AWR)3Q=l2~vX=NuDz64yb zWtZBi1St_~&BZ!!IaF-#L!cgF=j-#}H=|geyPAuYJv!U_LpXFFr~vKHRZ%toG~GJL zA9l+hd~b4C@T+ewmH`7Ter3pC@pa0-Qf9!kzx>T)JUxG+*VGPrvViLIw^JWpXiUk| zi9f-<+Dvsf&a9i}MW^oGt-^kza7?Uv+j8Sglx~axa9~;R%kVVoe8{k2xmf0e{RZ!8 zyfgfsIx4mnQgTyMS*tgcI|=_tqcy)3)Un&O7b6!mclV>Ebq)BxmA`_zD?7pRsXll6 zDCq<8L-ahQa{c$$z_GQ>T=^IN(`%cp%75{owX`~Ff6WbCP^a5r!^Z#lN19spKaCn* WXd2}`ymFy}UzTR$Ok<24HvbPMWx;s> literal 0 HcmV?d00001 diff --git a/import_graph.dot b/import_graph.dot new file mode 100644 index 000000000..01a6c75ef --- /dev/null +++ b/import_graph.dot @@ -0,0 +1,16 @@ +digraph "import_graph" { + "Cslib.Foundations.Control.Monad.Free.Effects" [style=filled, fillcolor="#e0e0e0", shape=ellipse]; + "Cslib.Foundations.Control.Monad.Free" -> "Cslib.Foundations.Control.Monad.Free.Effects"; + "Cslib.Foundations.Control.Monad.Time" -> "Cslib.Foundations.Control.Monad.Free.Effects"; + "Cslib.Foundations.Control.Monad.Free.Fold" [style=filled, fillcolor="#e0e0e0", shape=ellipse]; + "Cslib.Foundations.Control.Monad.Free" -> "Cslib.Foundations.Control.Monad.Free.Fold"; + "Cslib.Foundations.Lint.Basic" [style=filled, fillcolor="#e0e0e0", shape=ellipse]; + "Cslib.Foundations.Control.Monad.Time" [style=filled, fillcolor="#e0e0e0", shape=ellipse]; + "Cslib.AlgorithmsTheory.QueryModel" [shape=house]; + "Cslib.Foundations.Control.Monad.Free.Effects" -> "Cslib.AlgorithmsTheory.QueryModel"; + "Cslib.Foundations.Control.Monad.Free.Fold" -> "Cslib.AlgorithmsTheory.QueryModel"; + "Cslib.Foundations.Control.Monad.Free" [shape=ellipse]; + "Cslib.Init" -> "Cslib.Foundations.Control.Monad.Free"; + "Cslib.Init" [style=filled, fillcolor="#e0e0e0", shape=ellipse]; + "Cslib.Foundations.Lint.Basic" -> "Cslib.Init"; +} \ No newline at end of file From 048738e281988ffd8e1a119cb1d5ab2316a09dea Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 04:01:37 +0100 Subject: [PATCH 074/176] Toolchain update --- Cslib.lean | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Cslib.lean b/Cslib.lean index 6f5f3afb1..94ef01771 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,10 +1,10 @@ module -- shake: keep-all +public import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert +public import Cslib.AlgorithmsTheory.Algorithms.ListInsertionSort +public import Cslib.AlgorithmsTheory.Algorithms.ListLinearSearch public import Cslib.AlgorithmsTheory.Algorithms.MergeSort -public import Cslib.AlgorithmsTheory.Models.ParametricWordRAM public import Cslib.AlgorithmsTheory.QueryModel -public import Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort -public import Cslib.AlgorithmsTheory.Lean.TimeM public import Cslib.Computability.Automata.Acceptors.Acceptor public import Cslib.Computability.Automata.Acceptors.OmegaAcceptor public import Cslib.Computability.Automata.DA.Basic From ceca5eb4f35f75138c38036d4f33b73de16f298b Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 04:02:58 +0100 Subject: [PATCH 075/176] Remove graph files --- graph.png | Bin 64547 -> 0 bytes import_graph.dot | 16 ---------------- 2 files changed, 16 deletions(-) delete mode 100644 graph.png delete mode 100644 import_graph.dot diff --git a/graph.png b/graph.png deleted file mode 100644 index 9ac5daf0eef69e2a6299afbf8078769476e9afaa..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 64547 zcmeGEcR1JYA3lt~qO_EzLTE@bQ&vivN)p+dD0>yMN2yejA}PD_h^N1;$QNM1NA zN1?3Dq)=Amt)aocbQJIUjo)Z=rOuzFERz4i3Zi`}l-(4`v!@j7f_}H#Iw{x`E{@qA z?l0JJdfg@mx^pMDos~Vg>g;A-Q;rvt!>g22-YE_%)(mR-*-WZ6mwkD}ecddEW8ho_ zha6k(&eKQgCnN^0$+5rsIbGHf#QMx_t(pG&!5O=tvadn2NBd}xzZC8qna&mv5)vYh zh+mexu}M=&%YUY1Z(6Co{71`+|Gz((Pw_7OW6(KG&0tP0F0ZQX+qb8-nDX%YM%=$o z=#FE4MRn(*%3C)s^tTaIgMYunq|UGUM+)ZD&vXY-H46ibEW zD+fs!8O6rM#VKfNCjR+zQ&CANE-C5q_3PJ-O-%*vu&1>o%+5OK*()mg8Jn0W;zI!e zj1BemJIC>zfO~R9v@v)TMQv@1Wcgcbl9H0vtyy#EL@0xUV8Qg%)C+%q|NMf2o}nQg z85xDC zi}ar7dU|>=3MCtx$z+zQrY2=`bMrrAWBl*w>FDU}9UQ*Y)z!W18y@CmWo6CD$@z>= z;K~1tkNZwkZ7S>R>})oW7pZH!UX&0kn4h2jv%kM3&L&aGBtGdOTZ?ICnwqbqPl+!7 z={!u0DmT5J>hoYn>JrcQ9Yn%0*K0VS(=lG57uC)E&ac5$J4x{$L*_Gp1*j(DJ-mvo$;l-T;AL~ zX-rK{PB)*An_J<`8TXXn=;-Jg-N=J4jRW@X-Mek`<{L`3Nw`d@*y%iFdHFhB;nw%> zPj9EEXAI@yd3;~H15UM3j_h4J7zaow{8^m5K>1DJiMYTEBihSu)eU zfq}TuQA_efyu6oh+_>?`%S*BB3A0yKO-;>R?c$c@hjGNVtsUzwv-$CH?e%NdcD_@T zxAO}PwV)j~JNycRfBl5{7$WH+zVztPBRLh7mv7#@*|ufN8!{tQR6%Yfx>sCW3OC=v zv&V*o6&q@{)W1(P3KI4G9P#PXg_5$e(CrR31ND-cxz?`(`I01-vP^N0lA2oF)&rLX z0xN0L0&;2ai}Ubdxy_q5OL%(W(&r>3IPut+NF6upE>3wZt)#DCFKyqpEe7Mnbba~y zRY1+4|zWtdM^#oP3oO-#=z+J528+g-)`I` z5;iem&3x?Er306PWRW!@TsP*jAWZ)LwZrT&B(Gh&_K~NjFG3)=ipni5MJ-WceHB?K zeSOB{SFc``eqf!Onf*%*VWkb#!816Pj)tysFDB`>yOYnDZ* zoSfXm2Rd=X&O&EVm$~eLfq|dBy-^sQ&0wRnX5KA9tz)*sUny0TU0Tl01($lU>g$^yLvCvr|Ly9R-f@j?=>ftr_vT*8Qj5R)w|4CMP#x z0v^8|?0V3 z7v{-LYHMqs2L!~WrXEJRiM1W+U=(vmH_soF&~%-jL|RR^&B=DyWQvl~H6W|59xvuN zWjNTFI6FI-?C0b21_|9}q(k$A2VIlf3hMe~ZE>vJ=+8qG!+VGdq!1&_bZeS{_eRze z+&gycz%*SD?yw6dcktTDe}`T(J7{Ujs$H z?%ctH2PHq;-{6~^Y!NsmY*4uiMf`%#aM7ZR7sHWWpCngaCSmjXfrfbX409y%4yW;o z^`e!26QdvKxDFgR?;~KqxWA7XP~evC8}MIepET))G3Y4|Mcmm4Gf3R z+P2&5;CaF;tEClkYp696ThFj9(+q`M84G077i`OU^r-6C*w_^B=1RVXiHSNHakCLl zv!z52kCy>fs%i3{f>c> z9oh=sEMfw;eyfmsqqw!^SVe0&4hhcp@VQ>m(FvoW-B~>_U;6Rmr)!7%anWjIhK6Vv zR=t+W;A4}&)2iZJ7Z=v8TQ}P<+4jD(Qybw>kDriGSj}R0ax42K@{K@g)VbE|8{xwR z(;Z}1wr$_OUtC-~Q8Q0z{@-*H_6%?N4YgdpCkc^`&f^urTeq4zg3$9?&7F;O*5 zVsXB6G106o^YgXCu}A=iUtOBw-BB4^T+y)|^F`V5#Z<^-=1-5qP(~9eFHGjyr;>{n za!Dux>ow=)3#F+g1{}4*-9#h3#TQh>93~7ioqE5%Qp>p+8DihdfE=D-)Op5ZBk+T& zXL+V+%bSWo;lUT`=KN~1K^F6w51u?xLSeh(?!I4=Y`kQx0$zurDYE%g6B|7{WaK?x z@0WTJW6@b?z+=&0D3ZE9r^$a{m+O$4)`bFJcIn#0td2PBCKG)7;^oVQU9)N*T83@a zu{lZ5G9JAd5#lg#(5$milht|R*>FxDi`Z1Np4wZT+r3qx7T@T?GM2Vem-WEl;AEq^ zMSp*EC~#dyluT$+j#XcrUfGi=-k~@7vjg!LrKKBcBc-a=WdwW;6qXsmTJ0A@fd4Bp z8K{rl@r`p(?pH&+zr6LC{O16mlk?M^@j!PaJx?sPd9$Q!o)q2U;k*0!S}m5-`tRsf zX3Uq*(6mO<{eSHrD=MUMtA^$jJygr&qWK|<*>2Xw81eaj8HXPa52Wk7qXMvO&ATMB zR@rd}S)cS0Y-a)EdJeI_UG9v>ZY5+|bS7c4M4V%;XQ)k99vk_Di^@k|78}Ve_vdSx z=&$2zNoj9yADYr@#nR4B^kd19AyTC_Joyqb-E;BAgcUark00B)vu8D?^p4JEWNV-} zPyFrnHtDMj&K)WINA{CRSMhC98VaP`eZxu!1PUr`(soTeC?Cba&wmApK@OiD(yZM- z?(I5v2Cxp}d>R_sY2P&8BVU5LHQC`f(qDX=n(SIr(**OJ9(v@q)95Jr+MC{-^RynQ zKPXxI^Rus@Rqt2&CgkW)d_%0~=T8nG7x}15HIq%+owHkyd!V#9FV0V+NvY`FK~Fz` zJgBIq7GP{_yp4$|e(hHFU%7)xM;c!tNK@KhX;#1BR@F^^oAYlt&j!0F%P#56ecGC1 zBl+RKf13i?m^3D+^4!vs!a_Ta6htQ^aNoOs-}ukZ&wcslH*DBIwiYQIDBfQH>5=W~ zG;Q1W^YQWN6&$td{e>s?iRcS)tlYV1hS?1ewHZk6@Nd)zU4OLGbA~sgA*V7W(PptV zBVQJ^tU+1ZITBf|-KI&i;zh>P38}=qD6^bSp+M=BloUoG)0fEX2ZXbx#?m@)x1xXT zBLYUXY+`>t?PEOQl--!9ZhK{Vld{Lu*Z~p_LmktduE~_+eJu5}nI+0jQq`PQLr#OIEx}NiDVpue=ijpY)Wp@^A?K&a51b5 zI*K-?;XJFebtQi$Qcrk&y@J?iF?H@(DHDM_1%JM9&33udO)UHyVUlSI6n8BYGHnjS z%?F+w8$NU=AS(J+$Vg%O)NJ~s6W>%`y;7fOS!UzBNmFV@Kw+Slmlr1ohwSCcPoks) zqt3I~p9OHPXfzvgHXjl+E1%!Eetq5d4<3`)BLt{-I*m)W@#edGK73e{YcrT`-7i=1 zlK)Jo>p~6|(_kdEtGKnPh;Rheyn+G(zwl5^z;YR6YH~A+HVX#a@yXoiP^4G3k(Bp) zJG81FY~IHv87|@F`NwP9EX-BeDAN)F^4^T~DwjY=B0QQ$!rm1S$aAjga zRboMuSwW}pH%s>)-Q5{>V?Wl5DxW7!N_2?BMPTpT#f5)1$g-v1-XF~YcHDg_82NZ>9L{7Ct@O z7r1IInv`d3$Xh$d3ugzofQSr#e0(So)9@2m!{kO$mH1+QsW)q`ovADLd3}E0&V;ehlR~1t=2_o zKkORk3uk%*C#Tvhw5xMOsevAO)Y2~;kO@(^c=1s|`EBa(rEI-R>(;Hzh)i3ao9w{j zPuZBoUGk;d_V3@{?J)Kw_skjFc zrW)Jb#9HR-r%z8Os)jEV)eDS#b?Z7kpK78iZ)mB%<3p5{iD=UiWYw(f&X+HD62xI- zWP~nEXbK^zprmxG#zyUG&QzbS{>PFocKQ2Cpm^dmL2O4U=&vhX> z>e8z>EMgALdAmdo-QmF$h}`qna*#xOA8^7s7rl}xS!|d2+5R4X?Z&K5mv~f!bXET- z^jqDMSEs*OdDnOy6c^XFD40}A+g)ay!Fl8es2cM}k00m%%02P#_mO#|@X|h3*SRaK zPNTPf{PC#|jLZm5Y*5B^wr&-x33fc$=%n>PD^dM26u_7~2{=cGzu!H)W~60` z+W_P@8(-7c&$R!Y{DPMCghrEwl@}7|YcD2Y#&MY-k=Mv(AsH@p#oY)wC2)8Ai{*Sp zrYR-T^0Kw{JvaVM4Hb!&s*!n1@5!^~pB6=jbl#h#AdIo9rzxrDUOgzD*aIPUrvVm( zJDt*M8q#>CXLJ{xgxW{ISr{WjmCljXnV+aL@XBk@3KF?-`iTD5r$C=bB}OARySg+O z`OZ12U@p7XaU48YgW$+OtGKkD00?b!+fEr+{`|C=M?LcrdVGb`r|*Cf0~c~|W@e_} zw&-85kFT$njSPYuKt_?kJ}0MqkgY~!=JRJ~pbt=}&lriT;zLS41ckC|pJVDb~tWuHMjt=q6c5nGa7CM4mUC;h=adrm!j_Dn5J z-|GdBdK4i%jx~Y$=l#Cvd6IaE6>R1;>R}+#0wZH*!J_(GJz7j(dpDy_W79{PCkU4#{+6k`GnK zu-I({A$iAkDJN;P^!~FhG_l_^sidI5v2WiQ1b^;$<*~_TJ#Plh<4jCU>dv9=?(XU~ z(rq`3K79CK^Shbfi$zS0FMsq7C@PnEzU>D{2aTy7Bz^HnN5Ld|r4Xy*$GR3Hwh+dn zI95PFz_2Ctx+U-AZz@+ps0~p{;TO*2_(xJc#g5}bU8#n=vjPN4|baaoCB2RKH zQ7*+fpd5c?G-=g6+RjA;2Y$WMUx0bl8-%}|RV(cI$UF>VE<#jL#@3h|U_q z27oqd%{wl_x|Ckh>A-)f6}c3U2O$_1t^X3DMAt9~Do41qYz0L_6FEkhT8@eORUwIa!@1>lxd$y*ER!`0$OdFn&i)GbPB&@dMgMF#+VzfbDuTKn*G%@; zohO9db*htj_0`p3=$MU~k~CX0O#DH>5sqcgnfr!lG6@tHwH-DcIb3sMX~bd9TpS$L zh~%V1^(^D^7d&68s+1AGNjbfYq^H^^@mMy?yd5E>J0iED*a*d5Bk$HwEjWk_gDMt` z@*p?&CB4$eH81(~tWgJJmKxrzLv%|#U=pv#M&??y8W}c&N}viV{*E=EH=i7AlEG-? zLAih;U%K)hT*?T4FD2~QojX*kR<1OxkGUf8vH?|jp^oCuw0uD=tN_7&fGSL2`V0|9 zqBnlrWsAjq2bz*Y3E2liE*>5KpXuo=s}hRkbx0u0B9_H#-V*Zd*|R;8NDOs=&4Sjy zWYK`xfa*I$H&pDmj01vVBO=a%jhY2Yef*XSbsYc>#Hcdn;rYv#q|C;eG$o-PKL;&a zP)_6KDF^xwS%#377iDCGwPZkOK=C4}>i=L8u?FZrzja)vUgn&W5k885R&w(4Hltmq zn2+1ZB1ii*82f#`CWpQ@*LEc7VmS01U>x;siV?>s`v`T1X6GzmVEjA`3i1+`0(M!{U9NH*p!u( zOFn)ie6@sBZB$Y{_<^nwhV<3T!}Zh6P(zuC)xWJ=_fjbOa`0g_2T3_QyKI0y5K7lq zYC$_7iIm)wg{5+L#mQsW04Ska1qJOw_9eFkDEd-SA^1K4(u&~x^Xbu1Sro9%8o>;@ zOLTsX;m9)ceEy28Y#6c;sDCbG#g>*93{s9f?vW#ei2;C+^uc=K{-V~u!u}Ib_U=86 zJ`mtR0aWH#3$(CG1DdeROeHiP=ohR1Q_*m9(jkG4C9wB&{E@|=^AI91b)*(Fr-aue z=JZ=BC_LBD(D?0i%dLHBPg5%2>!*=HFfcHbsvN~5aY9Oht^^)Y0Z;4Wea{u7v8;lSL*2d`C9aml|kpBK4CBlYHG%pkS-+*8@B0g-?1Ye ziU($?B9ji$1M-cCQd_s`6^*QR(Q7M_E*rSANv@~I{& zk*CkjR*9Ag719dq$VyMZuM%h6ZRe?`SFfA+I`J@!BLz!>a3c781mBn*tC<{lcu0*9 zu;ZaKA}}Q`G;C7{W>CqPSn%hG4OofC1+nz{^=n87@`i?nX|YBvugV#!)@A=#j*@gQ zND((~q(I<OBu<@e%69LT+v{HSRj=M$mD#V73@9T5lds$E18g#b$w(W)w$!otEo zfBul}9q9Zggz9H$W&;270zkPTqBY78J_a_9NW}5+@!)KG00P|H+_}B&~q~V@wPB${55R1{N0^dj;wSWMWWY*HTm-Peawl^c&La1dsHY zg0QBdriSWuEnlcWylF0~2{WHdp{l&SG{?n$P1~&Th0hRV6A~_w>p|rH|C8^LiuZj& z8OHtPa3j*WpgKVw-?!7qGiuluJoe2SH=aRz2V=BfQcFwg&*(dT$vt)@)N*Q0tnI zl71HnngUn}q!I^_n;jjwz+~Yf|A)Gb$;FRWty;yvvj9c{V0^`Pw|J_h!s9j-jw!<6 zQq>YuRk$JT6B!5@7y|HhWRELXUN3tb;!{#;)?BOHbtE=5wRVkrK&F|lP+(PFLjS{C z2KXYrUZm!F=FFLRYA$i{BBcz@o9K7IZmNz;v&*N+R$|GAhlhO@7(ND@wD4s?xAyV$ z^u)9iD2tec6o$Q9UQtoe+z48ag@uKTfM~>=bQIpxoMv3aj*!k25)v|G9uy7^dH_k2 zhyw*uD<~e_#v>#>{uq7s|NGPb<2m?Qi*DU;Wbe`>))Ej;8UdleikDbM zzQBqoa0YrI*o6=Xk~S7ZnC;BiFyCr##?aQtFFevmH24UQ*H%R1O|q(4r%sOJy@f zgg19DSyMM^pq4Aheu&DdoXa5Ha&HYetcs_ic$`%}ORjCnwr9^CLiK<9_N`K_7bzkl zg6%X9<*)csx~6pLxQqvO#=L(0Jz)kSZ<;|>=9zPpu9v?ats!6ESgM=C0k|h9C|J>( zmz~W4s{j)2TlwphF4_M+^Q06(3C!-3mzT$1)zF{_>Tz#9mD`c!(&R=RAZVhLw&JIz zhQ{-tAk(r(l;W}K|3?0_!B`P>68o7=672;cPA^<|5X?nQ@i_J00L~)b35Z22NuUql z&=%tr#eDx=+?}XN(3nxq1xy;j?NC!TmQ{2Rc85~j0Q*fj95|_|a!81P-t?X&D(2X_ zpf$0tkOV(LnJ0a;P*^@mxA3O)^%-13N}3X3ro3HWx&&<8q{2`D0W0Ltlm1sx-@Mt2 zGIbD85ke+WC6F4B>iJA~R;*Yd@rjgJV#YXomXrxJiNv{pstwf*sK-XtWQAKfhu=~P zrKr6_mxG25VBzVLT}R(Qe_8sg{htT`ASBD{34S?Wuxcvqr1RwaS|asQZ zfUHK)pOUn+7aQr(moZDXsyv2{TE=T6HaR)zFQ7wmDLf;oX=z>uxwxdzp?;~XR03rV z#+0yh1aK=SYr$X;4I(QBkblph>`P0VJx3vUPHrH9U06P5+1TOhTv z+GTmi8Hy7*4vLH+QI64W!sR3gCQmv@MCy0_qL>Z_c*5G$0f7P6+ zit`niGj4QC08q4B*GUsWmi^MpVrMGLJIAZ z+;}sbH*x}okEV{u?^L^v-aHFx@C6|P33v7RKxjSWTjH#7^rtBv+f3*UiY1G-^Q0fS z12aAkI;|R?Nrs`RHIG|^3ZPgmMfV;GMiHTn_zM5N0gGfhl1dTDR8V$QCP|D^#EvAB z)qX3`yl_Sz$;PNIO4?zn#b9kl>$8{`4j$Fiv+9|qSEh&CZ9qSoe0|9e5%GC}6m?he zf76lD08W9>49^1tNh57i5g<6lyWY)xxvlGZ zN_6hL&iTtAN%KHSO<3nm-acSIKqHK&|ePtQ#v6&&+!v=fg0 zD~tIL*&QbnSf-nzLU;-eK|w_><)nH%GT-1B*~cZGJHWRoVM66mfl-8r#$EvB3%wUH z85I5-KKANTl+w@;qNfT-4Q=>McDBfTThV-5a#E)f(F{=R#9B|Ab3Ta?Sel=9@^QXz3W^Qp43@eG|< z#H#i5zrdCi{Vv00h^1H%X$>}p5UT=shlpBlW+VKu@qwo&x~^aQ+d6xG8fHw5bZUF< z;A@1pDR$raC*b@kw;D5VrIXdSe3d`?emyc=-JMnIlRk|RHD0n7PO8ehkift;RT;f+ zNMb_f-(ui?#Epyz$%g3#8F{nAnea_uCrkSf*f0vuCrqMCB4pw`^kr1BI$TJ=c31-) zM8?#F%VcxBQerJhxP$=&p2DwyW41}CeU<7abtk8RqeO51d;ndOR}#&e8VIIUO-=Mx zeU(f00jMIE;V8)2Teh<6rC|y|F~!4Ba~hL0&y-~3lMHVs&wL@<5vZ{GZP#Jt0;`}LB1NXh$$m_m5Q-RLgWOwm(I zRFX7KDXE`HfLY0%WD{gJY5&9ZYXW3@V?qL3xyb7E)&r>KwI0%kC6_QD1@}pa>Ws z(k)LOrt#H z$)V07Z6+a8S*R~;pJ6#bZc-xlqg-C!&(=z^*grcF2S&L4;lPR=&a{#+`dOz{{ZG-= z@R`>(2O3{TN2d&=j^0e?{4xmtorGlA(b2(k;??NQeqaQ)ems;}>#(1)Rt-w~1VsB0 zMiI*}=qDLYGdBryvwL^fn?Xnqet~T*!6q=>fCaYvd?#9aAdK`u!Nl|EX)LzfJ{ zU2aoe%e$-{i4+#C_{_|yN6c0r%zPq-+Ok4z3y2j9#aWo@Ep~Fj-yfc{Sg;A?^cd|T z7YCFTL5z*K$aZKd%kTKCZM@DB*XEtwIdlr$IB+BLz(X%e((&bjeoNT0>m7QJ@>} z1qB2yG#;vfNAOC$(T#0}7%k^%Mg=Fu1tHw*z}+gVtW z;4uYXw50LDK;R|%ghkBw__>?l@)-pTpRyUjPD9!USg63CG$g7ELxCZ_TWn9sG`-Fn zWz0lxB}NXoPe3BZf~F@PJ18-Ax{0XTPua{`QqK|fdHd$gdtjpkRXu>GDcU=o0M3tC zjUb&RAuauRv}>!|nTz|E@!2NiMUDW-oD;m8YK75v(JfbQy2D>^esL3gX2tyF1Ko{Y-X&eq9K%?`` z%Cb!xLR*3+W3MC`GERuF89{?E2J4q;jwuKAW&?v;nlbF{4KQH`RM6q%!P&ECJu}$Z z*a=EuBU z>)~7-(%h011~h7f+JQVt05G(A-4P#(2>o)u-IZPXgc)%uumM7Nntny?R+;0kk)GOs znf1W|tL0k95^ojceGVQTFWL1cJ^zPvK~6eDRG)3@T!T}DK!{u`ry`Lq&HVMyn2bh*#6)BxIWR(;2I%)(fjxBe`~T(`c5yAe8n@^!OmD&wG3lF0zAo>U|ek=eo3gp z;1?bJ?G#N64XXkF37j{EQ4tBH0iCiS&<%7?X^;XiNV{1rHwD#&F!dYb`5oY&CZarX zJ)-qs6gCecD!bZE%{^#fNqw2gQwG40hsSMM0IiMmB=-a;0$AfjHv?=4K0U>%$Nw@O2^5PB>LL+w z`}_L|?EyuvzPXtLUU5`PqfbxwkZMTEFD~KezoBdS%manOV`OStPsB$eRGx5BAzcJ< zS;63e4qTEHZP+4E9Cs3B4zmOuND1T}Vs9JRFU%gXd{1hid$gIIF!Fo;oE)54R=Z^3 zC&Rgc=f1w-;6~9fUi5(tq#^t~-Q+-n6rq}61Zv2$wE&@UkN-18WXm$LF!V(BL4qO=15Xr~<198W4%(a3(e7 z!1-k||B31Fw;Up~p`C&Ii&9(@QJcAqU<(T6@^XRs|Niv7M7 zi31bV5I-N}RRXI$M8|fThq7t8db*tfA@IV}v;3$(m~|5vZI$2drC4fM zpIb?uW;J{sZ*ab?p{Xgl7A%LdkKNdS@XVmueKiej+Lp;1VV{ABYnQkg3sp98;#jDb4=|@Bn?YfLW_RPF^0=FKHasV}q`s{lAOD>rWKN z&-!UbaN$q!u7+VEuwXr<>o3-)W@Vuy4%@2A^kWM?tV`;5rwLTuzt#LZ-7KR~Kf~FW%Y>^*i05B#ql39{;`3Cwy3{Q)Zecec zjN9+j(Rs;`?dm$3m!yCH)Xt3?X-E3HZ;0#nhByxA3_A}03mJ6LK9F0#<@B08?x&!` zp9)oKub}3KoxIvOLu_`q^3TOPyNfF-HW+6xGJ4Vcn;sFKnW_B4t(lUQ#IT@?)2A?xCGmD9jr>^c0cfS}(MG+7bd>t8iFZzQ*ZvvF=I?DEbW+tXUUTWRF z&(?sLrBG5-XwRQNPjSo3JNEncZyh~7YMf@K+<$fDz<~oI$Bt1`*tV=?J@;_c6n@&( z+e_0meJM6Dkcs?lczC0_dK-(uqqTePZjx7F@#wjluEqnPT~k|oCn}14&7IAp(EXVNn=UitCD?*i3t=gM=xhlcD&Kh)GbTP=>8*d1h4Z>+4`xaHx>laAGA z#lydMbydG+yUb0`M9Y&{#A_vP8{U&A#kOV4%`2zgIOEjrs$EcSkLws-imn^e`R?@s zTSl0}S#a`bw?HQD+r;VjXthX7u9~{Ky}nj>&FEJrdHJn;`y1&lbNXFO%M4^T;2!@( zrOW-G^somvrJ-=6+yA@(WmLx8)CZqk==%Me7AYt@H}`!@3&WO&AG?lT=UltzW2#D6 zbZqQe+@AT5_^drkcm75$wj-5;Z{KIYs^d?~N z(+fxm>%8Un`$jM-kzh$ zdhvq3zNsm^u#m;Z#zvOY5C1!9VffqDty=8Xs|pMVu+zVss1%-*v=O7w)L+x=bu8~Q zve9jKcj}Fu)?WriO+tj6%K{Trot`;$)uy>xC1 z-r8EPcrg0{+Z`3|;iqf2d6sPQEWzm*H(%eau9YvYqLECMGsx^`hvi{Vs$;NHTs$QpQR4(Q%JWwJTO-KIk#bP~+IP4oBbL zWM;lFsD6HNKWISO!^Xc05Dg0~@q*Xaah(%cyGVs%gPVbkE2J6C>~=+t|44h9Z82M3({ z_w@g>_4Ebp_~hh1dzN`8?;CCx#goGqS>hvgFR^WThiK7WoLIk3WmIx;#>@QeWa!q@ zxn_n1E(He#bzx$uHBk}T1JFD;96z~Y&o#?_&Q5tHrTewDa_;t^ zbAz?4R92`NH2E_XRNaxkyJ@hlCF8!}hT(w%pgdpcOVXM$koKRzm~%P#43KBN&t2MU z+nV<>gCGmb&))^C850+G`ug?#0Ee=QiuZv1pZoc}PEFl{t0NsBQT1y_l?!W4SlAc% zxGxV9e`_*j&)o?@CG|^13`gP*zGLs6;WpHNyy_=>Oy36wJwf68ot=H()U*SAoO@^} ztCO?y_wH_LU}8@G{ny+!t-Rf5tHM&Iun-*=w~pK&aSad1I_7$)&+NX!iLo(S<2 z{a4tObF&Q%A368ET=&rtOIcRt(Psd|F%2#i(plp=JUA%TBz*J86&;fpG7NkBqrjwg zG+wKc!H&bj{RE)8zP{dijY1BxQ&W?_^3} zKRv>HyHn-iemE%dr)gG@(bUXr!=2jS5*1}-tI-4;=P3DeHo@q~p1Uf(pxri}N(L(s zQg*dTZvG41Z18lN$-(t^`*-|J$-jK^Bn8Kqy88OgJ9|9qcvIY{)Aa4z*Z6!U@l>FR zPhr|L^HDCC+YeA@?T(!2Zi1NF$LxsO-G4Mv?jfFm!|$Tj*1LkQU^jzpZNF=hxX()@ z5r6+3h=xj>9CzF3UBAnRc2#hXBg|fZ$Dx6_*EFl7F?B}?%_g^uW6W2+@4_;>Eljp3 z)S1rrp_`!5tbJ?FJTWdL7yJCr(TF^bw}MYI($l*@44gT2YDFmK9^T5wI7+o`#}1~) zANOo|NW1q3oXGh?lt9efLD_R__E2je!CGu732;sGxiT+V6zitKEuo{c8$aK?Wy>Al zqPzF+GhPz7$;R+WrSO2bc<1g;c?E^Lu&|M<(z1O2`SYWDLBf4KOUpy9v}@L!#FvqH zd9oGnZaV!qwqYrLBO+F!zs#4tlW|D5X|A_de}Tckz+fc}&7S}*ATApFAXpH;^wDZ= zYffeJlF-|fty?udK91Lpc;iML-tK4jp2Bj2XtJM_rq9;B%?$;2y~XA|fH$$3nT=tu z6pf4yS{Q3#rk?|4a z{ZS@{?l3>t!|r80*mU}Ws~pERFiC<8bGnNMW;4D~Q&G`UY0laQ;iJ_Qy+%(e^?B*| zhP`}zbg))_`uzF(*7X`GoG*ca)@4a=^R!k}L+^>apoB z^44u^LNvyQAe2956kG=-ALl9_Ja`cHb$9=Z%uJze+qUgKa9}k|_opsj-k79S@CfbW z^XJb;7ZQLuM8Dbn5}*F_Cw272rqgQ}Xpy!r(Z6`xgl>`2`fr{byg79Oc5uAHVUK{o z^MKcM=G&SFxUjJyt4Z9tB}6U=r|Y%r*I$Q)xlNC6+PQO0tiq$WZ{Kb_#l22rGb-20 zNV%3hzu;f3qTUP~_%|KZOf zH~lE1pz*d1n+}V}>Xd7!CDNl=x*#J{h7*U+LPDN^_l7@~{-k4DC;9}$B-no{G`(xq zuXk7Ayr;sQX*mG!_;gr4zTs0<)p>JsUhJf&fq~`jTBfpFfJAYQ>SIaCo)afnU{l>G z<{;28no5*r+~mB2gD4#B9^@u5F>6l#t2k+ACxZUoZiD!(BS`#Lzdzp!C>{(}tm_o- zJiQY9C_VQCu+h&eC~Sk4IU{iM=Y@e!E;_G^8@*8FyKx})_yZj0IC|~cwXn#@Rj8W} z9z8m3Z7l$Gb&uc0%`7aJ!v)C#ZfU+?4N@T6VUiPU%u_$VdjPy5A|fYw{l{r_G&FXB ztp1Lm?!V^CWN2dY0Y@P1HhD@T8^29UbHBuX#>we8Y#bFPzhSezGQI)NsT7%!(GaHU ztgp`wU(2&suhs@%UX5z}nE6=a?&kfzpLMYN`XlHRw>8(=P7Wvrop5G^!RI|_&O7ij z|FRYZdfY22%6Kzp7yd_AyM~S~`Y{sFrZ>?U8Qbx=pT2%QDCT~ zL%MN!_)YHugn=sdgfhIBot*~HjW$KecdQUsg2&=M&a8$5|Dx)SPEVi5q=AmB;FZ?S zFy3BoEJ)Eo27f7JrWVTE`3kbJ4lESyYK?7eOp7=&={O-KTnAyYw9TGRJ(Je<+YOI< z@&bn@C;5->eCgOR_pfuY6vudH20@Yicy^v8=eq&=7a03%>g!ihuudP~w`nbZJ}qul z83-MJ6<&nkkkurnGWAYJRz>9jbQQ!&*N+m|IP1I?r$SC|T6y-|xvMy1e*A$T-k%W9aCrV(j@4hhI>NH&%k~%r z&c8D=dpJ1OpkMxoiQ4n*!dJCU9Mt|hI*uc0p@$4AgHC7`9)UidiI#wenX3aCUsbDJy2&@m){3|DH8e*A6p)?Y{#2X4jj-FRz4H{6qPU%N{a^d?-vo;+I3vXz@^w8l4rW|lC?^KYOBR%918hqApv;#LD zt2xhl6`J2pe%-VF<$-!Q^EEm)_70|lCy*<)C+GiJclykkW8D7OmmqwK$~vu%B&ubs z>#GVa8?O@gj+Kv|YMXvJt4ZU&AbNi_wN+IhJeAOUM#uMItPly$ojiFmINg945%q+OQ7hD;qiXJT32dSCFTJ>eh(YlN(j!yuv1wgJkXxjyg$e~m!w_v1a6BT zAnrx1dTH@pP?O{X-I4xU@4@$f9~v_2zc!VFO_`vcwGryaD#Yv!oPB%$`SV(Eog#Ll zyNT9>Evp01huyE&9=Qb_1|jw|I51qCR&~M?F92xjDj=(c^Y*1U>4U`9(etPGrGU{E z9Q%3;DS~7d9GW_bN%836)yURSqICM;4FG${V&D|yA;_gI7M*$nwhXkhgF9Jh5i#aP z^S2P!W8>ZMdVPd)uzA<6Z~X=*=0?vr&Gh(FTGy|{YnEoY=jT6v8!u%{W~TN+4`}h^ zQ+-3jcW7XceOO1~uF`|H`8Flx)alby`V|595S>VCt#@KGPc-g$$6wpncpqH#Rj}-T zM_d=z1FeC<{u(02gqK8|f|{pDlR9A}z{rg~5553N8#X74=aGABabdw>qvqm#D7(B2A%19tD;?dHvXRR8PCQ?552czNBE2=AYC zP%+EIp)WlgZfEWgp3I}Qp0}r+R#5(z!}rRu@Dp>j4&``pM`dXIbt@FQI#Jj@o z-_&p2T%ws~3;bZ# zez#_A!74spYVM>fM>~Q*XCKV(+ySv!Zl;F)$G=zX6E72sB zkeFD4gRbsmwV?nt=i49odGjbNTX&F&=mNSecBf@nQ_V^NoiD&&K_?fx4F~&3ni_)u ziePdnMt&drxK&06ug5sEH+&9`M(Q1WS|1@tckJ0+jEovpH|;P0y{r^~=B>`VJ0~=g zk3vjbeeTG|Lik-C!R&Q9Rw2O2b@v=^Z)!ci(>~3izS}>bC*D`#E=4ZAqN-|i^A+@W z)alDcy+htx9 zSq(5vq6_Y@zKY9|=kM(9!rsq@foZqj#j)N%3tc??U;HkMo)voXPN>3ZvtjfU5?O!o zt+5}Te7DrlLVuu}wtxK*Y4i~c6IbyTALm>xE5L_ap9D#3`W|%-)W)Sk@l7r}tW*bf z7CuXw8b5ghry1Xsl&nIgU4fHBmw3}~A{bar&h31aZ2qlpm!KPF4<_ZoB*Yq)oxKz9 z7WjzwL5xB_)x%-Gmq)GG7f?#UK33F9GN&i-zExCL_e7#&fsSR@F*eu+dx#?AfZSUT#0DN)IJYj{ir84u1CZ zDMe>A_()@MXD2JXK4iUaVCoZ8QmF9Og%c5S2jMoX?yvYFI|+9piISIsCiFP1G>Yhf z&weGcD$ByChd6EQl>jw0wNYrk#dta>(AnQp$$;>}kJ;aO=k`7;`LpX{V z#B2CWfL7tfoTkHjpR%`ti2hP!Ho6Qovs5EZJTkGW9LH&3`U~yFXPTY_Ry8)#gWR`6 zqQ8Pp4I%#yL@_LJ5|=K~qO^PO`L@BqTUF5}5}|e#-i@~z870`fcIp$axlyw?{nj0R zl~7)}|HJ$Dv|8Xlez)iCfK38)9QJN0JeP-zY9n}$)h&*PEv3}{G-1r z(&}Q6%aJtX#ct$$iW`!QE~IkytVvS#aVGyRfG{$u4kD6Ws-9OX{{g(-Z-Cihm?Cj5 zI`7rm+G>fHKLj1O-vU5vdE>?@q(<^m4tG5#xRlWxtfr7EYiVn{nt~|V=1I>p@W-~l za-sh-2nLmb3jS}}ZP$ifo_Kqg!DxcspUO~x5qdT?&PWd3nsq=gwH*ij`H4CEINUL# zfByU!fhxKa;Z5oukVj*`=-V3KiF}>FF}8w>PYGdMH$O(AY;q7w1;Pcg_od zX4L;v6-SksQF=YddP4LAhCH3+p4B*j+Ibe#HoAii!opchyvNX_xHq8_#2cUJEYX~x zTJGWIrj>fZ{SNyucP<%cmc;-YHin6@J_`sizL^6Vd@b3|C<|a(JdhB_=gwLH%i)ax zRHDI^IxecJ47Y~AJw%>(os+|Wab?4RbOXURew~E-sFOEV6fY~IprNC<0j-RkVDZW# z@5(B{o0Cw*saCF9b+xnewmF0z(l$}L@UDP9O$Acqu$_MW-!10lOP4;vMaHL5x7)owKxBrg!aea`N5xXucZv(*@y=@7}O?V>P+$Rg7Lb;BnM|y*V#jZLHq2K)o zkUjH{xGj*iACe$UPv3?L+njoRJ&bwwv$sY%yzro7<}`p*pi*>is^{kYmc43X;tAzG zA|hhQ&nNWd_ezWfjektZCM9MXmo^A$d`h@ZQ z9BDex;jjUFqqy$gzke0l8jqqP@y29rZ%lGnc@>{_;V!(Q?j!Ibw*R%8uV8(lfq%9H z-odwcp%7T#1dW_6#D}74w5rwOFdD8e(Ws-z9}bJpjZz~M+(#q01vJtzyw_(1j`ouz zhjJm}{TMH+S&LlE9PoSZ@!rwzV;G${~Fy%4UaVik1p z-UT}(`&qL#8m85&S94=MV7V1T19cxSKj;Q<2#@r=&JTF~02u}f@?+A$c+j!3{5i!# z`BYv`O-Wl_Omr5WtZ#P^TDmau*x{8BD0dG)hv;E)@RDNe7*e`O9~eTT2dm^!5;m6t zg*E`Gp8-AstbT|&dFiJVHh0f1sc0e&p`o3&a%>`LX`r-A zQyNqfO^%UdrHr&RsHCNmv?SU?sI<_O#_zi4oX`LL{eNz5=W}lFqh7D)yg8UqKe9WjEL!73H|j~P*@9lnwwHvk zR6w7B5}$$>d?J=W5`P{+XfY0I5ki~C^nIV-jjiF~;lAk0n!uZTj&ngU1LRxELJQ3+ zo@!j#DOw0l&v(>)A}T6^z>)v~rZ_)k;f#NnLSg{QE$;9<%o+}q_$Rqy4ifs|+lnsV zmH+}A3;Bxy37>`-cL!Ry{-1-*yhd=!<$~@%Ai>u2vN<` z64yNyQ7^0NZBwH_EyB3JP{)ctJ zrPVuVxhe3VeR}@oszFw?vCNJ2F$dOhj?X%nDNJ&XWL`AV9bTIlR7mKc5-5wLB{K<1?Zx4@-F4s;Exp-0I11qGVtNKmC3|FvZAsRjSnh@;|U~y+O~7&=gW@it;kOlol!GP z6yKyDWu%3Tyfb*#aw=Ypdjp$*8x4)A1eMjWGciH@9m|=-%Ow%R{A{mmk7YF2GY=&>img0sX!y1h{S^lW27tG;0^{ZY zmC`UUSPnAc``e|0X@C#TfUfAQ(C|Q75g7-_F1?L;R=lRaF*9#TXB$%ej|=dmGNm8| zk-p~6@k$&d&jXj6{(-*9?e%CA02?mmStJ>>Ho|_Eedr=VUuIMV{794rV#Y77w_cZe z^4A2b;OVNu4Zn=GZ=aVN!J5bF_zO+`*b7jFeJGm(tNc|ie-dvu%5VUcRnq)PE9}*L zOyGeHb-84DX8B~L{!fx#xq5Yxkm|xEOZ?Fvx1^b0n#;lQ3IVICs>&BHfgSJ6-siW$ zwe<9HPZihEy8cp+8h#@q#o%t)9n1~v<6d4~9?50T8M-jEN0AG1y@tL%ALDwu*on@s zU(YeI&WA8JTw!=X6oD9QW~I-+>$^CX_i6ZajrUWg#rdG7i-2Svd8btXo@c7mcMn>? zD%A`00GiKg;@SSDN^&i(^?}GC1V7am%sOe)+R!jTioWYHQy3I4RYt z6T;xJ(cI|}n4`vEu#uDmWE>z+&Th9oqkG&kFf-Y|C#-#{N%UlLp5c+$Bv}FXwpqQ6 z&lW&uQh+{Ph;23wh22=>R7+U%mJCm)mL@T@F)T@ki*<81NlpIJPqgD)vLk>-x(MhascMw6KI0!OOzo#{UTD%Q3OzKAlSxpF(H9R zZZRZ1DJZ>^4L$86v%H}gVPe?dYtezxz!>(X`y=Jwm78nbIHN53ryu`S>>)ogIsWlf zhOLdka7w`@ofA#Kn`l0Qq3TOzkcQA=89&H=@cV&cV`HQFqX#7pK6aPogQpjJM!jrt z|MutsHTZ4VE?SzJ%*<+CPcw9U21@z`8n?*XpDGw@Fnto=ItcYnm$=-*vPQ!!=egMH zQr3rmDq@n1Zos7>VS&WarDqZl=gd%xQw3O_m|@+A0ic9w0rLdNvgn?=oR4k-R1C*X z%yuSFqOnx9Y<55j#oj1Hy?UN-e9-o{ZQou1d#0=>POVFIe6EA@!>GD@w7?J17< zZoF=MI3-GZQeWta`JRr9sba5=A?Du#IwwqPD~CbzHqSphhah|aW`xjsGd%FX53Dy{z5nvBWF-6unBfehmpO!v&PFklYM&8M=v^2ibWDo-!2Nlv>jAhhMojUb^NgO?>nBj9S zu!4)%C%wSr>_i*#&t7!+z#jw%zyBBhCC9!lmzO2)(=QllhgiS5Q3llQjt7sy?MDq2 zPej9~+@4O)?zsCkQ1jd}Bk!r3BA6jH*6OLPw_fY|qavU;715 z4x=wdZf|XTZ*X5W2$Z{ zpc)1QIp#AxFg=_l8YsR0(E<0~loAK18@&0IOzuD&RY>h78af@FgNvbpnum#n()7e& z^u|<}wi32|S|}W`>^lQgaB=isXJ`{+Hif#R5L2Uu|DO0+lD%PF$m2)-^Sq~iSupaz zN-yqAX($3agr#g`YskJ2?@Qk+!(OvXd;mCYfco9MBh%xDl%VY;oXuV)w)LOOrU4B$ zM@z7OT8>(bkH2kJ`Py~S{LvaZ&x@;4C!Zwc)_jDz$%6&-sqpQwdN14^ua%8jD3r@* zlmn!f$yl(0pP%!F40YwG?jb#HmwsP<_-fj3nouD(m_t5nl#wXZ_e3Naik>r2HO~eP za9z=DBZ|3kn**HI;!u;>G-oX(Fc52FTJ=KvK}|cpauNHc7rq$z{D?D!R0#G_foek9 zG1Z9jTsXO2l0#j9WF3KGOpT)%ugmpO!K7p?{2e3tWan-IcF_1956iX2`64I|alwxk zmM+Mk`W!PQcZ(2)`-uYNBlos@$;nl{FLQTN^n}{a0Y-&T==xVymX%3$-Hb5xlAb_| z!?J9WYSwjE9vA+EgA>EsK8t+1-Rf1YWd1H$@pZ+H=*bWNvvItxD4(nh1G(XTY%D#K zw1;2Sk?ze!H_aQH23fkIthIgM?ox>F5C7sLZFtDjFLysEgp2AqATL2-8GkoGl(uNF zv$BMSRq&7HtdC$E0pdqJJYjmc^&sCeN23`U!5@G@R&Ln9iAGvt?frM%&SNN!inLRY z?JC5^gQ2lK53>`XM@+@panLW9vz1fB0zmIvt}+Hh2x}PG!}?D5`!50vFfR10eb5cu zzyYAsC+HfA0KvWLT()#+`zD`X?4VF^Xqg|Ka{(HJj$gMxQb_$hCHVz?i-wbvB;Ic_ zWcSJ{pfaGrbq)LiwZ>cqoof!OQ9&j5s?XD62Dg^ZJ`L#JXk^bZ9J@gIlKmFBE_*^L zZQil?efY?c*vh6sbNIRvS_U7n>?;G^m6Mh;fre?QJUu3xvMNSPZJ24P>*{jfPQtJR zEewX(U@5%mJrMkCTE4~9G=M(!4+16YL*0{iR0VzTh)PlK4r|RHH z)2Qa9Ar$Fcyu5!gxWM%AM|mrZD_+n;Jrc)|c9t&}7njhgRjb&@$}azB*p`v&;>c^l zAo8O$xo-kgmwq9FzvQ+uydP$U`u_ckZjWN^;3_fqEF^3URd5*6(0&NvtH;#zLHhUD z0r>k|eB}ZZzX51j)xfw#gIWNC&05o6C`R=Vz!rnO=8xXc^xgfx3xM#iV{l=@3D*MV zc9e<*;BzV1Si>#sJB~0rFiS258&Gl_t+U^e(dS_fR)A760Narr*F&j8M(?Ty;xHbj07DFapn&ZF z^zoFJ+CG0?6%45jP}N1~a@T?l<2;^yJ=N!Jb4$O#%=wxryt5iA<35byOODEUMMqmS z%hU0vm2RijdZ@`AnnijldT$J&SH;EiFu)oZowV#vv90i^iS9UoDpDOoK87klVjy&j z{82HLnnYGqL{?;wC&aSPPMHi2@% z0O(=Sv?5CZ?m1X<8aM?l07LaUq;f?1>9#5HP4=1g##m8H$}ly02pm79VGk1#68lRf)6+s#EkTkG_|$aaXpbbOi{wGU9$+k z3desohCklspa+_Qg-D5WpeUQ=D-Kb#Fn+^W>-5ye?veOft9FE!Wv|RqFpL(#C`i}A z*?9@R4rZzwo%N;=nwFwK^#@~&mIPFa8x)7J)gj~r=D`lswSYVW<~KgB>Gp>e>Rb#d zW;5~|8x4RXa)S^wM~%xLXSE%;6qk*S4Kujd!O%hRNF5KRGd0x;CsZ-;`R0L=Q~;Qg z8M!kb(ra{hOO8rLf_}$BdkW>dI!+%A#?-i&)ncmI@Zy)@oCZK~J{R-D0z54~OJUOJ zZN17@JA1dV*b48STLOiXnY)boEOdGr)2$DM)qJe?_)xE0qoQ(u|07yluq|#hJvb}G zhWdRGtrN;_tP{?yDFC|3mxAS6GRo!cvr_G|Jo~Og=gI|l!GRR~%>cx2H@!sYdw_%9 zZEI^2LcwYZtnzGBRFnhKB>TL8dnIM_w}RDIfUGC;|CmyaTACj5QriaL_1wyYO{g&bmq~MCmht9r68h1az$vRJ95hJ*vNj951_jf z!VMv1);&vYT*N97()K?0Os)8&@kQhOtKn~Af7>mpY>sJm!MZwOyx?2RyC$nJ) z#|RXr0VKqGut#J<<|xzNbIdC#!kCxu%myzE0LCx@9?LIM*c5i*LID8Wf;AY0u|N0+ z3!S2jQN|cvg5yZ<;R!@8B2l5k2f@pu>KG_I@BI@OU<jUVOI^72((B6L1GDi#G5(l7j2ap&Kw7O~sU!I!pv_x`;H0Tm*QNyJemk%RHNAv9m(dy5I{Jp)uy%o!098n-ksI>BGpk zphEL8zZ_yR0gITsiDX|)Mv!DJIKa!Ah}sYXf!!PDm87Ah`zoUE?+ zZBwJwUK8s(7{k+vD&JCfVE_KJ#1~((#CP%lG44l41HlIbkxLxMP&wt}fx(Md(#!iF z;T{vzL+fz&UFid2+2alV>Q#XbYc6aiz!sJ5TCjiJ6%i12kO;V2L?oAhntlf*wZ_W_ zn3SRi!=S69OhI1W6x0?rT*~SG&-T~}`C;4bY{DPZ?(Y3QJ$rJRdC~)|AIq;5BezYI z;GdTV+rt6_O}p9iY&f|=cz)q}2;*mZwcyu4gaJxAG{kR(Bsm%2c`DV#s=yvK4cMd&zw;(^DPO+KL5gwr@IWoZJ_8_noj%n!bVk=n<46uX48eZ`d(HRA9mf|wM+0nZ9RB!Db@gTIGgVtD9M4n@iHe6&A#eF z^NX6{>m0|PWO%~0q;&bJtE`gBQS8018?R{Si^cHhUgMc`@7`?s zR`Ingx36tmh2eX^A1xK8MDtN+k#wnZe6Y?M2U~65y-g6e$M*h=yV!gaU-vE~ zCq9@PUcG($N%9__pCcnO^0yUUt?}pJM%+Zs7G0w&{y?Ry+-yvfL&Z zlgHhC!|`1BvDu2*jCD)qK{x2E7Y64fPCpYU&Pd{R@+6cC?Xcuse~fFc@Rm3z59{jA zgKjyccjQRrksj9gA*O?<{WLfaF)&`h9L^u25X@N=o9e!?#=}-;EtB?ZArZFOo4%X> ziY8IZjcai~w-lqJD)qfK_3GzVv4M`SUyIo}A6?}UzMsvk*7oZ=GHp1;hl=!=iAcHx*sp`ZC2$wq*GfW=`*gjiF*uYw6eS$ zC!v(n6FUb&HA=x(W)dq_tg!oZOUQr7fA<53LC@lke!|!Mza|+=JrfVC`(-_ekGpsG zZvLG;>%7KgFBM11cK9weIA>)B2?*A&Sv;xcu<=9G349^NpB0ALe-E*<3^SSbX5v#Q z3lG+uWbC{rEu(YyL2e$>|d~DIT>>r1ibb2$VJjVw^tb?SWC`4p9 zDQa~>gN1jVO~e`PY4rq^l(uU>jz0D;c&@_fMX1%bRcN`|XKljnmQzqD06Puu1~Wl4 zTqFp@GtwD?92Lz3KDrQ8Ddeh&>e|{XN!P;fg3PS;pyn=60@QXBDR=~=W&FV;7XQRo zoM<`_UkmpaRb(MxD|o-Jne<3jYGrj+H@dOoiO}aT-MYZTv7p2O6oR&%umy(g_0$cLFwgur>B8Wj%2efU^6ww-@n z*$#5Jw_WP#U8Lk=MYFZ`%A4KnExsdd8ICRI<~-Z=#Y68R&!orugju}m(9u1)tQ)@- z&c$IwzQlNvFE`c?lJ9tGcw ziScqi@pDt0T^0t2^r1MS#;^12 z(&{aCN+)eDLXCu7gM|3voKkj0s=B(a!`ekbgdlEM#4VPZo*uAm)hCZ-BfN|WFR&?Y zRhqWW@lCp>Cy0=4Es~-x!B9$mb)$7w-!FkH+vhM|R0Zd>;>*PDFJ*6mP+-Bl_yg;V zt+zvbsFaJ7)zeKe&rdbkdrC_rA`dcNyz>{UgB-u>srbA)d+7a>Fs{_SP&1$GV$G}* z-00ccFBm%|C~9pMTWvYB1D#NEp-UG1Jt`6C$n_TE%De$J@yRd2Qs)qt0D842?W)~Y zb3~;B3d8U6=3>bf8@VT>SlO$t$1C2Jnz9}8`C9@rC`eHf zgKrBqtnjrmQok%-d{ReCQ~FA$L`9D?H%FJ4eaw-@tz66ks^&f2oOpOrTfY}IpFR@o z?Hep%%%U2YclHsVmC>BqI-i8hA-~hj$98jR3H~-xDD<}X>Xkh<#I!T`QS0T&k+`eX zM=ad@9!FPCZ>g7P@9r+O-sF0f^_yLbwu;<(?u&mVX}r!;J+ncb#jj#&;&5^J74=!U z&pxtxCn^1efZECp3QOU1U^|!PS za2o*WO1?!_W}HRdc0+^QVz2KCnsoo&#~-J{BwZZ*vC+s#dY@Flmt|Nv1Q6E^8Hs1@ zy?EK)Ck3(ce6>EMzawl;;we7ORsMRM^K2HXvphpN8H2 z1OJ0znL8KjDa&SD`o+mVAYk|*;~bYc+IgCRz8w3+{`Q7+*}GCS%TZtM<;3c!;uoMD zGJ%NFit7dLHGYNm(Y?kIky#)OCOZqChkgY0ge;!k^>rU}l*1^jN{VL7L^fH}RV-tbY-gtL`usX|GI98d0jx+|s@(-}{ z^%dm(xtw(V`!agcsG0ykx>%}TzkJ#6!v|f2E25g=?1RIu23ZUJHaMq^u(|l_UD~#) z0DQD$3}Tc9-%4pXF=ng3uF{AuS**??{Y~i>z8jbwj+5gqe$}kR(m;>_pN#ZOa&pf# zSo`s7H=h+t;d>vXBz*Mz-HHxi5LnB$dwbU^Fej0^>-OyhYFuE102DK=nm!0Q7&I`o zCc?U53K6I`q@e|-B@kx1q<*&x%U@QeVQehGK#b=H?T$t;DQ0sPn4o0LN5N9?Xw569 zhl@SX#H(XN)AF0`gQEpYceZ@Te_Vi=1+d9#2ix}H!-tG2<=J=9qI#L6i27rGfk2P~ z-5js`|NBdvbdniYy*E4o#)KwpmZ~S?;+zDG1KBeT=RZ0y53)Y!;Uu5$UGo#7KL6PU zGhg|BC7=QHNUm7y=x9!gb13V54L8bmFD5N-i#M0)7)eKQ|@_P>wTLF0_3 zx(6#(TB-*0oRklX78U%?rCYTq=3Fjq19iCj^J2;Se||Pki;Fq`U67D}_$~dMQ_`qI z9bsm)V@&|MUTJi_;8iXUR=yq?8H7F-CJ<;YsZV~fKx|~~wKAw)kK&i9??h=$6lS=U zYDT|atp22S>*JJ}r;+prN`QS*|Gz=dUv2u(pS<&amb9=Rhl|J_Hr{#vKEGMOl6e88 zQ%PXXGZ+M@oIkIM4FdWoMNEGF5W*{fkID`Ehrd*x`857H88a)#l0pjfwu9I!8;!E) zx;X|(M;7SAvh@4^zG>mf5ZY*ZiWE8Uqa3q~XFZ`r`NDl6&BYs-^u#R5<*Q|yuCWTx z+0B-+`J3h~F0=A~zon!q$iHM;ZmI4Lff@4gECwbDLf6V9fEd$M3WGpg2$T;vR_x{} zfO>Q(mkoHMM0)`AxFLE4l+il>?)1!3sQfUTKQ2Bl#C{ZVVMZ=%GJKDN5g`Ekm;0{(wk8J`aFK2wk1WV)YRoXjxPAZ0H?6*#@yFjJSg^oIE?;AOc1BMf!FeRx|%( z{*%-Cs{E7h++iT8qEIKa#BgILe`cz3GRjA>=+o-2xg=mt1K_p;vZz#w!}pU6@5h~= zIUCJTLUL#c9wkvTbZ=;f0I|#mzDBb)eLcy@;2Tq1>SCcY?`Gw{?}n#(fk{dUkU2~h zm>4MVfG3CI9JEYdG2Ez)89XHI8?eG`5`W(5zdv{MHO$(i*^JRRw*%ya5PvoU#tT31 z;I5&0J_6j_EU0nVA0V2&)tK2t3;%2)vszS%pm{3>E8{lIt(#?JW{Y!}zAaI=7l7p!-S9G#`%N)M(!slc(;OIhxI1yGQl#CJ~8m)psf|+HbmOT`0N=# z6rXPw3Mntq3rRphUqbiHp99T%;LoP`aCfdLM5ZXKNy!I8plz}HcivKp9EB4{uimy* zi*~HJ{eR20csbDi9c#{Vsh_ffaoEGeL=xhNMK4j`CTM-)L_TKjoU`>nRs~i@Ap%Ve z*NPQyqqv@y;9$XjW9FB!h#_UPwV6zSfq8%T=efdu&HtU~i--|)?HL{qLogr(e*ah4 zKu9!uCN^HcU=3}CzQQkmF3BzmkX+XPhUO-m?t(krccxAGjw;5EA?w4Y(vX|M?`f zKS^L{8>kk6Q%N95kju^ggn~}s!v%k>@#mU-yJ|BmUz-bV)* z987w>5>Vd)+oLn^^9T+K+U@@jpzYS)e9latl0@+WKV+rG*Z*_wOd> zi#{1wZ1KxC5m%sbGqC#W-dRr^%+45L;~mrNp|dPKw-$iBb-It`hdISfQeN5aoU7ZGsH z3&@G~V!mRL()Z<2DjJ!Bfmq8Tja2Gmwm+_S_lYnw^>1 z4$6FA{t5{muf%T`{JD0XBa3mh=henc2`>;z%XcU2KsuXc(6#UjyMcR0E8x6 zrZ?!;{BT#|PAM`GALo2qXC}@wIS(%z7f-hXf7dlvW0Z^7U{PTC-4oj+!P6Y5em7ZS zW(BWZV`U&!;J;`fYl3O38k2LATz-j>pLg1t5xLqk0cM1e99KrMR@TwQDx|ALTAU==kpb z;@=%H&P0I@)Aj%&Pxg;;Ukq^BdKAyVGV_YOOQ8G_;$pi~)BWT_)J{>5tsh)-Dl(B{ zl}LWRPY=ldIsF8dDjSo9HQ&JHziY$>_XP7Zv@=L@&(+O-w=ozz}Y4>zRNzs(Yn z`t#Z~)-L%3u5J-#!gyH5<^@jV)VvaP>9vz3UGZ>T$@}>6nf7#z z!??hq``zmCJT6c&p;?ZXNCq7dr>iQ);}|wUad`;^08~w-02J(LbGCSEST({ z1=~R)UWmi4d4K)k4%)ifrmyF#50P^Jmd})jyQil)xO>e%1zG%N!Rb-P+yr~#9*~s0 zX^tnDY;}OkRSffEi9e^xu5|ItiwaG)YgRykK~pf@j%$w(JT`v26#qqTex;dxnkv1p zj;`TTkhSltF6tZvlsY%lu%%4id}t|}hVO8mCHePk2FgW|HESN|UNDouUi7Q}^03wlqit?X*xolmv@8Zk*Jk``YQi;teZ9 z{_Lcy9)n-o!A55dD=9?L`M$BZRlSr$PjB-m~xd;%avD8k^#WHVnq&rA@@ zqryz%Zto6Z7B2rt%10zq&mS&K-aI;sU3SM z^*HC)X=OA_hj5F`c~^@7*|(oeGaEBfLBg-0dp`5WKd>IdO2p=I#x zajAc{9}E0R6c*CDpH;tWsbe620iHWiQ3ip}$TIA}I@@7SPlbz>osGe!-RDE`jwcs? zSQ?Sv#f<$55E+YwixXL^l(f!NTWSI$b5@A1Rmf{tE6EoEoO)>VdGUTgYklfP&BaG0 z56@lNFM}@RR8Gsfu#vZq5zMoXFO3=ffk(B@gMVjy<%T)SM?Hfy)w3HNi;N8#9k#A< zTMn58%9t6?Jg7~deE2(dKS6o`^3eeBZ*pgqhd6>M z6rX$krO0^j{gwK``6hb##dT&wKIh$qL>Dg<0Yt79Q~ga*WZn6Fua*kGV!X554Dj=w z$hpQ(TknPA4A{O3iV2TeT-D_CDo5girpPI#RkEAz)Q1Z(?HP1eI%PiRhJEN~tS)K0nPvk?UiUPcLWfWfYsgY840MqfDM$tB!;36>bk z3#)Bp3?gsXP6p<**7gh^aCkOh9J_y?U*K=gCR_cf-0iXV7P^l7>{*Lc1dXO{!adEp zh==lc<{lP_kLTM~-rFt2rMh;>e&ID&w&!;aqA(NYVk2V?I?><+%(`9qtlQOc0bbYr zxHvPouk){4PG|Ne4Zm^xuwT-C?7F*m?@8RAHS1K)Eh}*|mW4T6Io4ue8ogV4czLyp zVaSJf+nkmFj9G7fX7fhJVZPgy4+b*F<6=cStQ7iB-T5_DC;9lHbi&b13Z=LDMMld$ zP@X)HHV#!(D8yxuR>v0Rnu_x%*tVS5d_!hna3pPU^>4%8ZncX=X0qxqFEbcc5)wU8 z*4l2Bd^NZB=a%Z@R_Qmi8qyzZFd$@G{chEpqbuY1s*OY<&VNw6mwP@@G;4<#w@$*B zzP?@3d=jmIBbr0=y9yEEtEE7d1?w379{vT9k^X%%A1wL|f}*doT+vU6yI0cUmJnca zQh1r0h~9Iv0Ja5Ach}4gTrZ;^C#-(=7#|KkhES+84$r+l;?Ej$5_M7_3$umXfC#i0bqjxJy>lp+M&A!E)Gp~o2kZ9bf8@iU7_RM-9v>9EX>= z87z|Mvh))T5*QpAiHk5dOSx{f?wuS=8c_v2yt*hz6TKur=%Fpuhnlv@u*59JvYQH; zsYYx~(A7D)J*JwT1ApRc_n*9QUMTS}F!4UESci!1u{0}!(`L?dM+2Vo;_VsATxT?1 zv3H-UZE)+2duuXe4@bYH_J{+pI3n6L@NXg^Ae}ep4}AJGTOiEhzK0oTpl6QINkk zn7BBl7oB z0j1PQCruXwC%g>C>;@e^hMap140bI08JT_SI*1%^;#B0p284!CLnLDFvYXkVPwX?p zKPYhjLM|L%iMF2_T(lp zZn6aVKL!N{fO%MI!GUKER?hPM(q+h%(TBloXprn27}#S_FgZDSg75fVDw|_AnQi9V z2euk!i+qvlBEj$xfyOZG1;Go7I>pt=m1hPUtE~qmB2*}j5Nb&F^xPg1m zg-=}j*I#P?GIjRtI|H@@RuhAbhR3&l{yN=oPXLX7$3Od8TzXWgT+Af4cK3jTO2@td?G=r0M38`9*+4`e%uCj**b-|hj#_~ z6Hs8bf=q%Qf|deqkT-5sb{1AvF2F54@9&E=%RZm9h6XM2I}$KQ@vb1GKcn6t)s@XX zrQ>+{%TJz3J8&*Au*Nb8$P9=S)hxAOAS{rc z3~LGh20R&cG+FE5i3e4h?0DXo?9~*s5dk15fpc~^XVJp@wN@wektvy3Sqrfj@z>tZ zUEM>*mOVXX>ZQEYWOmI)IZm9IefvyTzkR*lqcVEYO`fG#0KhC-=&JwaVgZB%!)3%Q zh$p(pMuvD~Xf_^{!L8$=EB4#H6LV(IBK8cPDf>it!1cpV%IIW?+p(ZBrzg?X)rz^i zW5jb!HiJj$mGPtsZ7o2I3HdEz|%5ugm8Q9iF0;C z2L&Mxhy#SNU?tX_LgYjz%bcRuR2ECG2$^aTqCH;C`qYcTUYa7V+t%ZXn>Esz=evuf zbL+&ybHa?1w7tDwUUA%N4Cz*vro34S55_EMMUgzZ_%3NFGkp=qIdhaPxGottY5imM z2u&KM9JFPDOC8t~RAdG|rO?KW^C6OU4hjj`imu9sZKOM@Sl7`}f`&f8c5tx)&7zTu zajfp2KrlIRo`0d5p@g$vV8cxB>8OKyf&reYWyd*YKLiW(@YY}GacNQwo-`=Vn$T1L z&%pP~&${PAR^UV*1yd5f3gM8b1Koi~WEHnLQCy5cL4!l$*^P+mIfk?UtiAwN9}^|q zSgsn92%a69?7NUmvT(vueI-5z>KOVEpa9{QE}g{$_T}fyp~RGfsDl9*S(!u}lJvWS z*uuiW;|rV^;2Ux^q=5@2D8S2!T!Pnw_n+rGi-`+@^FLkcP%O9M%p2e_IuC{< zrVU8VR_Woz8Zcr|^J6iEG@h7_@M*z}=V5<^?kJA|+I14Sc~1@>B4sr0>%ccfxkx=Q zKobltwL`?vRVP-c-zJ7F_3b!-cfix{>oZV zNT5Xp77#Q&F>Vn1S;%XFnk;e~!O2K#!PQMyIm26+&}+cNY=6x~%?J=90E%*~kmCZo z_7(1`ya4~arMNnwt53|09V{I3tpua|2QFgn00@m5hZYILT?l5#TM};p)KLsTfYM|K z;P9@1QO}=tG7vt|h#KT92sAmrwYBw8s{v+#&}6VN$eR)#e5D(AwesQ1xkH)9zq?g1 zQ5G`AVkq|+3?9j&=XJhhM|OQvXcBZ7d65ZoHC(Q>OQr0nq)lD&-R2a3-30vr$b)Mt zXG9|w32*A!4kJ?7vvRO7k?9)H*CvS0d7xe- z(k%RY5+{Cd_C7T627?So+~Pt8N2Cr#&O&p9J6nQ|Wq}h`)b<9PI6u%g(1mI6;PVb^w&(5oGQJkZ2EE*~eQILrj|pi+apDhP^svdTsJCZ`SwV90N8s|X@`lJ-FQIZyLN zu=z2GB>HMrg;~lSjPNi}c@B({rX%=q)dw|r^MVB20?G@8gg{7H`Q@^ct&T|B4lq|) zvE|efmFWp7OuI~Q(}zhOgBE~{QP4U4Zjj?^J_jfe=3S&ZBmOxqnO%mAPWIjKGcd!& zjA%X!u;B^V4D@mP`ZkiN&;p*l5>eKtVUlg^GwFhxxUR|EO1sj+iyis>S?(k!=p6YZ zSqHVj9AXaF8j|B4F|;QH8}ZH@=ab-pjOi3N!*QnOgMq)9DsIUlgXng$R-GPr2}n)9 zSrlZm=npFYaRHW*#unf9(&`-!hyswH-7kAnWrR1fga?U6IYBrX@ZIu* z2%^eGAv$#aVS*Q|1s|3=} zIN6WO$u@b9wX^QLtsKp_);89SMKWEcTT}sIA7LT6Cbuz)LqLh=RL;wqTn!O<@+^g& zQq({n|FxI9-9EI3zH9OB-+pt8{cAZ%fC=~mL}0nB-7BcGPsrv}gI5r;{6qr|Po4DN z<04o?**EEh)lSeuz_#s`l@aEc5b9olgk=9>cg!9TqVwP-L`=?u@w()(Jmu<^<~#CP z{{3x$m(H$5Q0Ox(Kd2yPlZ7HF=W$URXQk302XZp$edvW=mpr!p_6HTTFu3K70hb4I zYC|Q5^v970t<4WykIGA&8N-bOeKsTWpk@`#u&FwaRq%Q1rH9N?aOEX z?jXhOp1(8KJC3}F046aZqySm23xrIk;)i=kLX1s;t_F;m-{rqP_j;U+F;vV-T~YDj zSz?y!uq>cnakE!!#7j>stE?=El(HZR){H6Fp+rrnnQ_aa07+`d6mIY4YlX#Eu@xzH z!+Uc%1ndFocU2L!Y5I?aC0=;jVD>6T?>ST4Ek^oh($ia={{}l063)AIPhVQT4L3(! zn@W_Ttx)N@`rAgZC+K5=SY@}426TK9%Q+a>crRzN=@5yI=|$p4JK%7cwtOTPqC7MQ zl)7-IWPgC+$QHYQtclnpf%$U0%TZUkL@uy`FjfNNo56_J&BdixZaZ4W%jDlL!{90= z!ibzcN{<$RBt^l3f^w9ME$)XXhTok8h!ltjkM?Lj#<&M^V&)@W!%O=%dg1htUbO(e z48OO&Qgg%gn|~pl&H&tUF4g1>m3`={J(WN+%^U#v2OpP%Csx18HFCCkA;PkhFOLJYyV)yM( zv4IoxpdtH1rx+5yh}m=yqe+bEh zSFfG}WoRCPwLes)JQN;j1H&+AA$IKXI9>LkQ(In6{M>=u4LjBB@-!T{-gmkjNMpuQ zd*HW>ebG#23>e7;zfh`DiIh!E$YdCL6d@dS|5Lvu z#5jq(Kq&3Q3}qQ|FA3$SfG~%z5Pbuw^eI87Xm5-+8+MMu6`+H>D&9>C$T^rK?b`bt z@}~|cwxLUWyG!wJb?c$8j@@iIhXd`IN!iJ;OuzUQT2?aLkjd_urek9FkJHd0cO?O6 z0e{f%!$!`h#0q`(Qb@_jT-~A3_E|eJio;R8F`4Fv@H1-1vugnWA|Eg0?mLwWLO&j& zgb8v4Y6-B&8g@21U8TVjw)9G9w@?m&)P)nP0AX6A-Pk9vzD|@)qfnKAnN4>0)L6#? z_{=Q_MGS1LLQEsc4Or1QPZzZ%Sp?(Gy4rEH&}8?D=vCG241R1Ood^MH|e=5Xrqdg;=efA@%CCE+&~SU!&G zwPx=aV(+>6a@&PE92fe@LAjQcGjgNm*Ow2=uuCECr(%|}{@7{n>`tz#%%0+Mx-|k{ z%O3;NA|g7kc^C&)4cH!N%fIi84O6h$@H@?Zav($U^hn^CS3c1 z`fC;zzx$FF9%hp{m>#-4p!$##C|O+NQU7J=V4s{A4W~DNch4}XEw_PeZ)~IyYT(_$ zrb$mWz4$(xgrPW6G~9*K(zQh9F|r}NC&^?UlMO2D-~?%#ssukfEi~%@6rem7$Myqm zR<#+}YcUcjW3%?|+vsW-)M#QiW&HnM^Cjb?0SEs6L`nJV+qb<&4pUeJo9GO{P>f9B z-qb;F8iu21K*7WRwZU1P;%K)U5F|O*UY^}I<*L6jOEw>rWt4oA$*&)bTbcI4Rqmux zy8Z?lHNuOJAJlz-aby@O?(*$G)LILRcdlFIeG?zqZ*k@>bVnK;Q`|(s(bzPFQ=$%{G~Ir#EBG!{P$d+-ra5dXFoej53NnO3DBdq(kOJ#3ELh^%5S|WC~0Uk4ON*OXj8c zOi$^S%)^!6!l;Ca_R$VArB`T1$acaU7if}aQuIQ)IF|Mdq`>o=e5NPgYa)cCmRgr} zeCnEV%yugH(E4vZ-oM0j%l6tsqbAc)y9#`}bBfodD9>}n-= zHV?^0|J@kjl=dMf%-||c3Q?H+i_GqB*h|DS^zWJm!9nexcX}IqSO$O>7h|-;jKkk> zV+n++4O;>gJey4>!T@?bf$=;18kNWgPfS0Jgy02uQO$j+bCuyhPb_2!cpbj@`DQ(T zR%ojYXbPBp$#2maJu>xk8F4J}IyHcQ{A&yR3H|I-Yp0XEX!6jj!n|07ue$ycU|9Ov zC;^J_BxLqZO@y4&XExM-pZ>{AhpQsGlJ{0dj*cm{o#<)F4-wLlLbAgLBL%X{j`WYl zg@^$poCl&#Z-S^&Xq%p7MK-%O+7fGZWtfuLv0Dyhk8w}KTd7JDRHbNY*(fr=_;wLy z4UgM5VN`+>9e@c5Wj8R$VP?ZVq)>keW@K&HZY5Bm)A@#%EE(z7Wx1>$>2JP>rkhdD zxf=P1D9eC0cI}dPYPRipE|=w_u)n3^eJqgH`5)W+*IkzSoeB9DFq-G^w51yIG%go+ z{;H-u_;IPy@OvEsEy$BxkJo^>!>~DOXnNLsSawB1qwip6$Vxed=B0<5W zm>j4moKyXS1uw*){5!7ay{MI>csV2fP4&{@1VwlvzXriX0&W}>M9|?DhYM>YV`UKq zOYBZ%yA{&xgqkqa?~W+goUPB3pFo1HJd& zY>@{D17!K>l8Lf16j_A|SV*1k>2ze#tJ2+&hX{nTdAr*JRAbbR>Ox#?c+cndu4QI` z;m8YUxDKXyR4>5!)C}}#)W4~}!VvQS=4TxK00}SLM=yBKXJg9)t%{shh)~ZUIpZN? zk2z>_kbC16aHBn!MFg^Wb{d_AJG|YqCb4W09{lWN(QXm_j)AJkQcB#^ zx}+#_vctwh(cqebeqeU$&When0P;Sj+J`2eiCYyF#7Csl@twzRT)U57P?_?szSX6bPr=b{oJy8%hd29SuhF%vy zhOP4T2#KcGb*Cw#!{X*UFpYL#D0!$ZR#Xgtf?#``*>mbwXM!@_1p;h{kS*Ku*)S<1 zv`?MDlGWM`^%=H{TqYF;OQ2dBSJt#uvK41BeO1fzkO{4@Uo=_$pPB ziY6V+S!~=`v|9_PR-y0}TnqwK3|~`Zn$f|~#E16HNSep7R~=z|MllkJ2$x>?Hs3lf z^Y|O`P8}?rkxF0hOxUe@(=c7X@4f3$nJ0*(H?`g}$|t{|3>n^7+6X$;6J}`;oA4e@ zQuMm+JPnmZm#>h}2||($i#xdB6Zerncb@sn46Ko6=3TG zhNK%iCP^W{AZ206F=c%U*_nrOPCtADb~vbq1YM+aMFl`L}1u zAnJ9Q#XMX(GKz|g-D&)&Q0Ktb>%;?Zzp99*^@_VsE4Q}uK05VDz*!2HX3Pe0qC~#O z3O7tw*VS1{C&&~^V8TVSL(K8wS<5rXs2Azz2R8I4G)}%ysiW7wfHK83GR4wF=dO@Aq*Sd2#lZnmeTCcl;2?Ikahg+1x)W zgZpBhwafzm4Lm(Ol(o>|79ttlEd~=rLO%h_koZDoG=jc5ZhCF4Ny zlYw&<531?TA@_MB$rek%{9&j@^=GdH?hwD%{HN#V(admGDZ3?XydNKadCRI0ov8Ec z(^Oc_i@N2FL{CmVUVavp4SBF5BrCXgqL^86Bl_-^o6RZ}?;^A4)i)peCYBSCi>WT8 za_mHmM_Wzz2Bj;WJLLAYCNit9*P~{izOmwp03J7tTu!)*?3R3;BXvUY!hv-~Rd+QM zhnF*3{M_+v$Dy|`KYnnDNl-h<+c#M0Gqo6H02+d>tF2+d!QeA8Q*J$8@V?uWql$8}yTEWx7m8BgtS4eydXwC&&niu2W;`Op!smJ-)&BE}!5puKB z$T8{De3j}Jm;150t41YK>us(iuJ7kOx@fVdhXh}U4BuN5@isydK^H-h5DYM`rl$j@ ztPThWyL*r@!&03yHoDxO@8%Y%u*3dyB}QE2JVX}{fsrOGEnSj@u8K$9u zDGJ=(ZW?A2Vdw^_7(#ZklP=Glp0u9;V3H<1iAvbnp#_!*bUhD6WpXh>8CK0}si3iY zcWAl7&+I-IRwwSCceWQhx2qS|d~)?z&9wbPZSCP$7a6P90{7=caTvcYYEk}$_5?(v z6q|ZUvPY(T%4v{pu|52-|2^1kCazb6cZ&7!5%vSz+RQz4#Ya#O2*paHEM+H$pVCj?s-v&-Xytx^D?I` z{Z{2L&*Fgk8Drw8z^9-$U|3A*9Oy|HQxEF(UCV^cyPeO02##49p*t8b>$ZOR{JBnP z1(ck#Ff}2lg+L5InnA{!`nHCJC-&WMytO@69eR**)pv$;XsVXFJX-1UT(OMV*+%7L zcmG6sF;XeXod7YC*?7*4|Ca3XKmTA{9}GzwftXs2sAI{o$QO=?Iw!I(B+7+)P4WyK zqPY?v6LQ!Q^d7t0yxG+nAGi*V+kP-GCKv+uA!V1JF-@zyqvl5rp`QSBx>JRgHHyi7 zZ&T)C0?(;aZYYXDs{w@esiYGiO0*z(or8_G5)S^9XQ{Cn#ONy7ZNM1RiVmE>m>yaC z7Alj;?38~hi5!{WhD0t-DX6)#UcPv-g1Sf;GSn6dc3(W*RV6%Lg?r3D57iwRAxm&F z{G*EkU{!UmXYl9GWOTJrLq}D+;Qvy-Zq-=!z{}L00`09^XN?_U`-Y;ZDN&-gcgm3k zke78y*8i;K;|Y0BZ*X$jF&#ij^*}?my}v1};=Qd!&(ly@=pnL+hVMO0E5@=8eY{<3~zp0V* zk+}QUl{_Q~GC`>#w`DLcm2fT!`8cEG!jCAPvm<7`{Q>yVlalzmyAsT|^NMf&!s`5Z zy)w+?)%k_aEGOX63!XjQ;h}pXh__bXjoShf{QH-8Fv|UceXy<|rPEG7I0aNV+N$eB z5QvRr`;9p;0cOq_4WLugMM$8<(=|X{Tg2q#cz{|F@C+v)->+Wp8glY^F_@yuBs5_9 z1$)NW8+#LU%^?Mo>BcqG*Z)6<4}-4WNx$XIZ>xK7LY zNx3{qH*b!hj6Yi;<94R=!Ks^DR8X4Gg&x>{`TgNs%~$q#%IQ3d-eT{YnCU8a0biH6 z_h`g%_KK~vdI5r)VW6J2ukufcEEmcz&l3FM5j1IZ=LsMs5pi)Y^dR;wFBEUZayIV0 zySI%l&j5lx3osga%>u#5D4fjTEk`#`HmY)7<8*f_Z|ThC!uHcsxSn9EKR+)qjbBxUUj-yQaXJkNQQ(;pqNL5VTusO!eAo54T<084 z-uFK|&wAFn*L~k>hNscce;EYt-@hMqa=c6M`l!A(h`ZNN#vw=jIK(-98{%UJ987u_I;*#NeK+}ASVpz0qS4nR1wZ@TqQB| zY|Ek%wuKDd7~Z)h1?{x!>x8Y)5N-z^r)|ZrZ05{PF!;{9rfW;X7w8l)8d911E2En4 zDMm+h`tM0u7SS(u#o1wY+m8SZQ%2(gn>MuvI_`~+q>huu14Wl<-11>)3$ghzM>((^#nyBRMzHgY}mV@ete z&cDGM=u-1aWpZgg0`PvS4^2$c%Yn^yXx)M_6q&M!EjwgdMKSDOf7Jp z`x6x>$FKvdX39K!B+6t6Vz=9so(y&f|4wsSOpSkY!Ju5>R>%|N=p(0O0=uAlGNOV3 z%`#3xpf{l-$dnOw%c#&)7zv#T=B#@vQnuf1+}9Q}VnznTD7ULF2JR!2knME1&e*uX_@nV)8vNk9!5Do z6G;Fh(yE^ch(7AfaGSzoUFZ0l0n_=CBc?-p|JDWj+M&FI<%HEHTjqt^i+BiI2rYs9X zh7@B7eNE3v7M?Gjxmgk;HvIU|Ub3MZzrHnN7N}y&Ed{J%AO{DiA*GqAb?W{5G}i=E zx(ats7=mpTjQoKN9hYN7?{pZh$6)T2qfM&c7PB? zIt=vgM_5Wc%A8htzExhFnF4sSn~WJF!BVWd<(8M|(GLyS)Nk&D&~a&=$y3IXoqJ?< zJ2yA5J6DN+u?A*`oINMb!R;M(0c=km!W@(J>qjt;I69CP#z_{P0`z%w=o7%>9rDOV ze_u2S>ZK5l#Pd()-wHW`wFVImBCX7Vp}6m`E`R^-f0srf6mARaC_cOLIsmDH0W%Ce^a61P#T4QW=GQ}f$5(Cy zf|EB*8K^;gqgBXPY{nRjI+~z*_CXA+M>c&$q;9f29dye_2m=uMc z6BGT99I;xP*FxQ}t;x3Ld6CKIjv2(+L9}g4m|1@B?%h#z$PBKbO5&rX!^0bj%7VqU zLHAgL+UHXQlT;qMP`Gt;Le2@19D6>c8>7wvyAIPhFQ8<~_}TskPt?pA7$nDD_GCRS z9v&d`0I5?UZZ{HgGY$)QEApdH_z<6TpUg2?p z+l3)oYMFIS5?n_CF;FPd^g?)U+|~GhdP5iIixX!yRc?fZRvgioK6pHc;?5uv{k33F zJ@NBs)uzoBS~x;&*3hWKIRJs8(07yB`kZHOzAyxE(v|xG{mv-;8}myh7WF#t<+SQUD~o9x5%XjSD8FG%ZI&r3&xjQ`UTw3`VUo`KNmP%kc@#A|#hU|9h=Is^>K5*uP zklIm!bl#KoFB3d;(H!KD+rZUKcq3w42?2e!yPKOrf!`*v+-$*uKL4SdJ2^U5<{S#C z%6jJ3jF13=4uf8pYO=8U^^>$_{p6l)^%F;R1>{y3T=hAj*-%yY&a*cW%GEMtH>`48 zmVcje;J^Xy#zJls)-^Xu=0Uhj^&s8l*|btq+X>#qRzaq%DsL96SMvAzbw~FP+?lFQ z_2ahGzhBE!!(5?IaPh8os4%SiIj(9z%s|k91OOgyx5fi=?yR3} zZ*Q#?L;nI&yy@Btc!6q))_*GBGkD*ztGc`TT0l!QW}9$v)C(59&1lz0_hDh{e`}@? zx4FW?77(V1uO>Ko0u?YmtaQZmVjgY#_6KM6(NOL``#o%Z{6M)&E-~*XYl8*MTS_mR zxv7Evo*>KSKD18VtoCMsSHK&naLiL(|9gyOcJM+L+K6TNT z4p2=bo`eSPymn@iPUW%BXFw}B=dK=Q*gd&B$^zGJ!%`=*G(e+^eeD}2_#V!BwzPhc z!=+Opl-{^d24C;tc&xeASSm|=KgG?H_6r_0aHAX1;w4F>Daysn=v%wP^-;0Xu_uXM z9*Hd`PX*n}cmiTV)2B#s%%;|PczdV*H{me!bZ%Ytg=Ni-;*Wox4^Vyi2kKyQa+mha z7tVFSw3@Pkh3VlGzh>2{Cx!)BadLW`c@C|YO5|+d;m@PdxeZVqhwO$ay8Pyw8bRaX zJ`n(6;@X-NBf|!qD7NV-6>b3y4g9%G+xP4LmC_IikmP8TMOmIh=5eymswH z{`$$24`lx2W9U3b724078F8z-Qb`qU)jvkX{1wdP##?XC($SSySJ|3u@{iN|cJ^|d z5UU@J{c7f#g#}%nbh=tpP%w7u@2l_jcv*%3BVrCia8_zg(7{?Nez2Vipo@hTI_fMMn+lLWokQm{ zU%y$Q;_ABDKXBEBR)d3%T$-y>8pxW*lVJ<+Ap&)5zmCT^3(Sy*43o|Mknx6Z}2NWIyQ! zSxuR*n$uXDl{?d<*3{b|RB5FEP@?rv;GnJKzQx0&7>z``&6(4^?$|po zN}QxK@8!b|eutayGIv6s5WO|0a2kqU?k7AwwlW8Sv)h2yA8bYj_~0h$zkTGlV=ji9 zMlpWRs!WaLPxMv8s34UkL&J~+g>akw-NGu8HF}j9gQywDk1$uO(pR%Stma#P%B4Ze z_ar`kv9(3$;=k}e*|v<_hIYgFP~U?60gnkBrFHLEkG=YEaXPe#6*cJ(AMVL-B2Rh6f7$oN8NN3-gChbQjmbXJC(=JJ;edMG+x_qPVz_NAyS1l(s zNT7UuRHKpm0@rD~2DxCTGNQ$mYE*COE@`YV1dH6l6SK%kY5g9)zlabqXRk|IdFM7h z?b`U>nPh=*ha?ki_0@6s0W<`pY7Cz|%G1pRbSIn9h)~~A)a}hy;;8;7X&Wn>fU1}@AY<=c27Qlu_?=?>ew#| ziMm*%tmzWd1P{3AeqofH5Ii#)rx%o=```Y*s^FrL6~l@aVH0-v{Jm_!?|L>t4BmN< z#V$Rr4CLCbgOjPZiq=E=6s&-SHUx;}hD%7G4EOd?@l-_ga$eN&>C1q(eY$xczG<*; zM|_=8W>)t-AV9HQ9+sn*HV^f0+96H7rAy}&s&$j_^wH6*k zp6#cv$s>_{9iDDmXl`|Z#mAe7^6*Js);4COrrwS=dJnKOCrukP|B$b5v&6VI54GF* zf?(D?;khf>+N8SPpHJt^R8Mhe{M%Wd_%Y}3i>`Nfu_JCeo`2G42|IIv&Vf??u~ypoyJIKh!P#qg z6t3RQZ7-+lm6xh!?ay_zv1zjP_KMV3l$L>4ZVUL6=%Iw z6*`rQ@g@ApQ&D{`aoC=n`G5bTsGc`@{NBkST`$Cs&Q5X(@d|FO?`3x+_qt}buOAORqIJ1wZE;1Q&g`oAii+i}7pi5;z>gfUF@BOWb?sWU%DB^et{1AB zEDQbF?Z}ZM$9fJ8`BAW6Bgb`}(}|dqY&>^**2PFlB3YKtEK{dZHcV^LjE z+d*y<_i^AjN-3e&6H%QLvIkRtnA#t0C54(`%)nbGrbGd~&%^PgD`g3Lo;E?|m6qw< z(iLMSUQoRJ*?oP5QTBb;&jnNM?W6VHsku~NANzXZkdEoyO6}mxhFR{rtD3#Bt6rc+ z#q8j3-LlUjuJm7@J#*&F;1@Qo)hEKN1HPw***lKe?j=q|jV`Ts(ZDk6k(a}@1P!qB7q$gO5?S0Saqp5j8m0VuPr9@$w49gf30c`sx zmbR|7wH^9$ug~4#1J0Y7&c)dM8+uF`BnmBhRAWJ4Wbi0mBT`XaPahtG#~CnIQ9Rg1 zCkxE?^{t6uq9^nSNbL z#$ID#oN-Aj5kbV&F?sN@Fnt)+7hJ=4?-shNr}i3SDE)^p$<#d{XCtE?!N zITvKbbeBr*4Kg*&aOIHD>fO5;4eH3qNG8hHC3pV@g=zcLqMa4Gjc2YYP6@&gX z3#qXu*!RO8Mc`z<7I9Y}eH&9#?Fw#<`t*-`XK7lHFOQknJY`qMl2vnI9Y#SbWlLq|kHDZ?(hcuJMb6l`Vl9gpUeNN4~tB(ur%40<~w) zyBQj-Rcuon9DRL!{KD-I_6Cu{PKfe)8*?@wazY`Qevtn&dlCdJ2% zKEF&D40ynqEQ4(qzPuV_Xr-w+u&;KUk57b$Yt{!tgq)pfJs+X_Q3kQ%4;h+jYUZC} zv&dN7-Ho+1HBIDwn-+dTry!Ivt`TYP_}R1jXO0TuVZe}cQ9g_$R@mYQK>VEdIUED8F_Lw!Y62R`%!d)q-)GC_zYt zc?*bsZp$n1|KX(kvV#J5j2L0R$UX)T0eRLl3fI}g9fSTI19<}3^Nuung5gQofu?`QJm(2wCtNe5F70=!`GtJo4dE`1Dx`5<*r^3QQDC+4o{k!Xc6S*jB`H<-i zl}})J?4*Oe|GO|E?#Hhz?kvMizF*VZ9A|)P!vp?G2<|cC}f<) z+P^CxW9<03a9vh=)yI!lJDcOJ3kkgUJ}V4GW@ zr6-wRg+Lr7{K!*Ve0&}>k@Y=ysG3bw-mAo6$$Ppyb~P}aYy01Q2*Dri-PrWYxw*L_ zub#LaNNjFT)v7I{c|3x7hQgpS1VMr{(s97F>W=M}a5@h@b6<(eB{{oS4 zK_O!4dmb`1wMNZ8hn_Wgvvf3pxxooQfKQI^IRN?6)BAi@%r@C5A%Qa)nnS@)&;q(N zzP#|I^ypcNR)+_*SYKHxF?#MT{o}R-KLBuUJuYXcp}cv`H4`XoX$db6P-*+$U0^Z3mA@_P zVS8!m@Jfc9c<_HugN!C0K7KTgo+7<+`X`@j7eY&Fbi$L6u9cxM z;^G|H&k-Zo31d%=mwvwdy_M`G6%U|!X3YXPE9o1L=rsoEU1;*-SpDxoqdkEyA}zuNYEDJbOY414IP{$p$w@-WYj?&K2m5}S>F%!C zUm*;=W%iFmA)h|AZ~dbV;v-OQc7^B%yjzLS0090Chc>Y)h2C&V2THHCc0mp}X~i~Q zBd4;8X9G#o9z5_?vU_yE2#0px8F2uJPbkU~KN)DsN~^W_hF9WcrJdW>fy;WdNx8{l zwwayX;a4H5I{JHjzZ@O>^AZRumiPLMytIjRHBossMMT|aW&k7mCLO&0-@pMRyQVCE z9(Q9UbR_m7J4oiP@fdV@@3jkw$eW^!rMCB#5A#Ad8n?^}_2S{fOr*T`k_B+!59w_| zIM8En7lu)@)LKH2vfiR$2wbrPkdlx5zahnR?hxgg>vLd*J;VF-0jV{}y-2*saLAw* zPPUK1*dHR51Ioj~RtD39e^wOdvYmYV{1#+>`+uicU6oH; zMG_i3HqdqF^2Ac0cE2qs@a2+13zkOH`-gpyLRugSk#^DHQ-+~Uf(G4`X*hKJZoT;+ zpg-9YyIFcNpb;3$Y~p0({Dy1%Vz({6A-0W_PunNhZRXm$jA;joA3*_VOYvG17zH!s6rERkux zue^Cpx9MX;XNOq@Z6;CsV?D+yPr_}wxGe0?bV%l`Y(sPZ2A+$4X1~21dNHV**oX>D z)82xyDYpzmL@=TthxoH|v%QOnK?;`(L5c`Sj@aPs=~ zS$4_E$qkJgi$IE}v>o)MNrji;Mf!l!xqw0ptal(g`s`V0ACWR;0TF1p!xhDGB|q(!Vq%X>Ww zkJE^ks|X1(4o@r@i1ClP$7N)J6ZYK)2T5F0wmBdmAmihgFE6@v;6MA6iMgV8?{U`^ zijLlvrlTiaym)cC-|pT$d)|brS0cnzUi8EAi*a$uScso@%hV}F&RkE6pcOLi%h~8i zt*%_`KhE>!WzMZUBx4OB&P$%nfX^O66Dpk2C=wW((2gV1zUt_z^qC3e?(E$3VQU&I zuC6Tpjanfu1y6l49}5D6$YKY(W)(%bV!msj6Gsfy_8^YsZ*w?9rbg2F>BhiXA3$7d+$2ALw$Xr&4{wLvNPYu#~w)Oo@bb@i<8w~ zSowM(zg6(Y_E@{Q4jD3pF=k2c!rVBNY%dP^or=Nd*i5o(3M5DoZsRvvZ(5{Lp8=+_ z?#ZJLmwgV!>CpVj&|$-beaQK)=xpCC`Ni(A@Nj&0&RCZpGU=F9o+uB@Ey9tk?Lds6QE zO)NK_1O1=q^dfdFVSeRT+mkWIKePMN07GgZ9!@kkp2R*<@nZYf*Is(qO~VPM>M2L^ z_wWY%ZIxSU;M0I^p+k0h-yQDx{`1|Z+V=o$hJBBqB^lJIHVr*?X*YAwey0!$wy)ub zr&;X0J5cr8(9-zF;Uqxwn-yKG#+7Nhs>I@mf82fjTeGPJsz}&iQZU9K>k;3Yk*c=w zV~4|M7Zv-5g21u03f_d$Ol#*OA<4~%6??k4m)ltn6Vr^5R?{~=*!y_l2J<#5sZPqI ztCAbve{%L_zS}2anM+}WUEzwSU9>bqrbx()h?=9`i-OMLtdY5?X|!Yjw$3H-H&%6A z8v2+or$(Q)(a+~@hzg{z7y(eWKn@Z)tt7Z^>j`J3be0rvAU58C-kNji zhOUsiIF|65sY8ZP_{8JzZM1QVK~xksDgOs-tX|i~qO^ut);o=AemrhiaryjtT45W* zUmh=CT3PBUD(_E^kEcL=eUh+p5z@Xnm8E%@6YF`dijG_T&-``JWzuj@e9PE{dA|4Q zO$if;V@>h(b1=!lf`C<`N}73NgStY#4SvpFpFNkyK5jX2PL(c6>&n2_fj$xU>GLIV zP-FWg7IPA*xWzl(`q+9;mGD98i5e5hOJlZ)m`=cf(qEMbORBSQ$2hT^AS4-{ z!-HCghtn=ERA>8i$*HjvavXGXbNcc$)l1+KcKkgmGH=+FJs07=N$M`{Jv3~yhZ^S! zS%`xe7p8sL05iIjvXi@){DK14GVkp+C)z_pYZB#t#vmPVvM-enAy=9$|=X3`bgyn&&;cX8qYn)6G z>%d!0D-L$Q|NQy%@G8jJ3d5S}O9$YKi$qemzwlvX>`(r+>J+1D6-e^800zXPU3kc* z{&BMqxbT))!F5P+r9y;A`z(G*=&NeZEF6q>WvtAIu!VUu>hK*sgeffX;i-m(|9sls zJjQHPXj|1BII1#gLu!Z_?rjUw3uDOR#6D+R%Pz0N3Nm}(BLF;M&Qy*Kze+5~r@_5W zzPy|>C3x7B!3$s9M5%1IZlJTXJ~+wIRJ*<0PIf>}Z&@@;aAGtob^f}x!>g??0l^UtJRA3B8kG|u2L+Gwd z1UKvUaz{kLo8cWa^S|j&ta~`hX0-iS-a8+oU{{H*xo`Q)SoiighUCo8iMxEcc<-sF zoXQM)-z_{#{Eixab+HQ=nit`eY0JSxPT5~IBMbb+ao-nOtg`LM1I49%P|oA0Puo!r z8{#;KcT(kVet#C?M3;+uhp-6{SqEsJ%gV~ig^70?CX;n5b=&*;6@T;zA7%Q{J93p= zq!x+Wh34e)gRe7Bjrjo)?WcOSne7IU3F20EFN=y?aNs%bMph=O0pS@fCoL zvz>X1LOlj@&?^6$>LP7@O8nf})gNXH`%);J)Me(RC@p3^7Hbq^G@Ml2rlDGpH4io&rrD?T3#QCI0X zhLhS3{lfW3MAiiCm&gnwSw=?DUS~m%a;|jDorbfA@8gj_n{(|cxXgWp+UbPdoOs2F zHv`DD)7Lk*RuQ=mcS`ATWl;07_^MO^FWKrcTbndMxaXLBnR12(T=!V=2*grmzDM3D z?-|N!ae!!?<_;$sa`wRuVEb5%1&uCF0mrVRU{E&BXGR;Ym0pP+VNfQrMdCmm1x)He zkk@vN99ekfvEt9=c@sqM`2Ac>W&b`i;;h!RtaB43fz(+(K8@Egl<8sTmL`vmZYy8= z9DEM0pi9ZBj>}s3&r7}b>H8%!&4E3v?tm(VUm2R7p%oHS2z5+xVr8YxSa=q)sNTTX zG@&pTa|Ny)7#Nz|$Q3^tG;8NToTu3JX=~y{|+bsh;g?(%OarVkBWrcJF3l)y9zFTi}^C}J#jp!CCcoLWRG z58lp18()#cGLMVm{x%=`+e4GU*gb!Vw2Avar-~v7|2-e64H>!euyYjrWSh#gYBqr* zsxGlAo5j=8E;$a9lXYtX2}r1;NCle^6BrV5pweZLGuiVrSnA}2U%%b&uLav)Y*%=y zGJr%PA{;_-UchHHWa8W(mgicSs9rEqi2WqAD6ndtkT8bDW|ib|By8=Y*F8KR5g@@E zWcn2?b`fHw4Uz|jaP=48BNLZ^fTP=N(Ji*HK2E)>P@1pd*f!TKpL|1xGjkztxZP+& z<=bZ>?bgAsR@DOwOTriJR5`6?dF6Z5qvw6TQZM-W!EmZWe1!5ATsBDY=@amA)(+CN zfxS2TMEFKUM6^;Q;jLk%-qh0zAgzf450s9vFL=gU3IT7Amg74#2?XhA97$81QR~Vw zry3Tbv~Q1#LBd@TAV!{{LEi&=s$7yTB4Zx3X|VgFQT zlsHFOZd`vJ_;o7jwGaR8OO^S#bgIsQx?a-~*TiN_nK`o$|7h#>?c1ptv+`;P42>1< z7{jn=X(z(z@^{ykqP+lWSP8 z!`D~V+dGn~39sXZJ3|+`{rdH6-k-sh`7E8ji~<>v__KmKTlLolvd%UNZ@w|(>5H-x zLasXx@py{*@$&3X;L{@eU~(Kfr?$9jGppDV#b`4PZyE&Kr5Ba45iNgRulVJ8`yOpj zT~lPYrho6YO%sdfIqkMxcHA?=bDpzvGX-kO*BK{UsdUJ1P6cLrFhylX;2qfd3OtGz zW-JYM%-o3G<8pJAhh#Nk>~c6MaPQs|6E7#xJQNvbtGdLl!7l0q9^~E)SvcCU)^w9d zG5!*FEj$oXVzdkley4tt!4;vQP64VN$I^3zdx#$rxz(wEvPstz!-J1yKEvQ(`Mc7R z64!xM7h_3W)+xm^@Dw9-xQ@wNnHi}XorlY)NH(oM%B4S)%74j3S|`A7nygz`rG?KJFI6{MR9o6 zQ2^g}Nm$3hdA+K91`DGR8UpukYF~Sn7|efgs9jd*^T7Ez*`?MU5^z2DvatEb-6}mS zFZAKdmx*_V95c<$o6Xx-bpE|}mPJCc|B9NA*|Ax*&m(kbGHhJyM>n*4m9pjwN)6slU8b(bn7o)1c`Cw|L#fi7gBol(krGhb}n4+p&EiLS>c6M zsKL)98*A%J;a{_6n_i=zF@(O9E`XQ zUvf2Hfyq$FJ$LjC^~HJGXwU`|7jqrg>oe7{RHftVaiQpGzK{D~t%99qPM`k#{Vy>> zW%d^w`?^myd|E&z{AXlC7sY)=pZxGSukT z*Lw3G24{Y$Br-I6V_WxZcj^!LHlWf^EH@uD+BmEDg4ncSohhbyWWaVk!szjJq53s9 zdVYRru-eSvUQ@ss^{&pcn^7Q7lr-SbAP=<_U!HAZ^+qPrc@t^pZ(T-WE!FTu)uSL7 zl_0`9!3iADCawB(bmgh6Qv1sa8RI3nt|+>wOyRJf_@@$NmYQ)F)>&$_aSXMB^|h|? z*&6HLUdLtiRq*oUPRHZ2olQ6!TS;v&e}35L^aQ`5D<38v+=%r4?CcxY?_JF)P_@mv z6-l!!&}zoDV?Gg1ct-mmwN1{LGrrNVwdH4FGu%#1wH^NR%SF-XwTBgRJ1c9dq=ts; z<%4uFqj~%Jb5C3hbl5B2ybjeNi%-Y`&gjn^J(=@Z*9%vjy*$8>n3!?+q)w&VY`o?+ zY~VJWSs8gXxadtr+%ttnt10&8&D`DH$$>O!HlJzZ`|+MPG>v@>CnkBHMuokDAka9- zN?Uxw=FXmaZdPArKlV~IRv2psSlT!)=oHmz&#~R@I(F<0o5U0w6IH|I5wuPAKfCG~ zrRXZw2S>}`Q0xHBZOqVcfcoC#>DqE&aSKUEJ5FuD$Y^0eE`y3rU5xp-`#>vW3QHd} zP?nNmsA!qfS!#)B|NQ(c`>9iVu$YpF@eLGAyYC0z61s))#j1mSXK2glpS&Hbf^&b7 za`>Pco1$n%%Q~%1%NB`)E?FNRX%8gbR3V2p36W?OkB&?(+SAGy0=6%;^;E-_q2{|< z1Bq$s>rX-{6!-E`P#hR?Q-vdC0)XIXw?*q-4q5>mgz%)tn$pi2%6DO6Vn)ehR#RPd z2TY|WjhnK5m)HGR3Y4lvj88($ODor#%C@Z{i8{oax502$b9GrayRg$}#v=w_Jnh~C z&&TIwq%BSO8<6q(3SA0q+}*Vj7k<9dCM0j|51h(Wa7XpS^X8(WEA`q|K8;jJFJCq9 z=h@I0n}7Dd368=5pWNCy!2BeGtth7%F42eq|a~U`pT}z8mRad z4iYtwc=w?jBF@~T!r8`oKjxefvw;E0(x-m}l89eh5i@QE&=H7MaMGDXBPkXcdrd8< zi(*ZLO@Ht2_3V;sn^(A6X^ScUTP(xO!19Rs!G2RJ*%zMXckArQZ|-`mPvhaigH9Ju z8#;t4%e$4#C!rxK-s6$|_FnfSp3Y2I5p7vg#S-e;zrW3*8e$%Xv}4=^su!bYDsWtD zO~Y@j*i@Ke-!U76owtJ5m2TAZseXJhFyd zq=n&=oTK$z@2}U+e?Y?>0tKywo9;(_9^9Ee?wGcwuY-rj!*?a7cGTxSeEMfUyB|nw ziC?qnfNZwxn8_?A8 z2q?3gK7G#f3-hQZdf{GoN^kO`jBNMgI}G*O?dhSpOn3>?>+gQ1nf5yh6NoB@44V&> zP`MzhEGIjg?}@O#Jm+lrE9a0$K3ZVVopgVSYr|H&`AWR)3Q=l2~vX=NuDz64yb zWtZBi1St_~&BZ!!IaF-#L!cgF=j-#}H=|geyPAuYJv!U_LpXFFr~vKHRZ%toG~GJL zA9l+hd~b4C@T+ewmH`7Ter3pC@pa0-Qf9!kzx>T)JUxG+*VGPrvViLIw^JWpXiUk| zi9f-<+Dvsf&a9i}MW^oGt-^kza7?Uv+j8Sglx~axa9~;R%kVVoe8{k2xmf0e{RZ!8 zyfgfsIx4mnQgTyMS*tgcI|=_tqcy)3)Un&O7b6!mclV>Ebq)BxmA`_zD?7pRsXll6 zDCq<8L-ahQa{c$$z_GQ>T=^IN(`%cp%75{owX`~Ff6WbCP^a5r!^Z#lN19spKaCn* WXd2}`ymFy}UzTR$Ok<24HvbPMWx;s> diff --git a/import_graph.dot b/import_graph.dot deleted file mode 100644 index 01a6c75ef..000000000 --- a/import_graph.dot +++ /dev/null @@ -1,16 +0,0 @@ -digraph "import_graph" { - "Cslib.Foundations.Control.Monad.Free.Effects" [style=filled, fillcolor="#e0e0e0", shape=ellipse]; - "Cslib.Foundations.Control.Monad.Free" -> "Cslib.Foundations.Control.Monad.Free.Effects"; - "Cslib.Foundations.Control.Monad.Time" -> "Cslib.Foundations.Control.Monad.Free.Effects"; - "Cslib.Foundations.Control.Monad.Free.Fold" [style=filled, fillcolor="#e0e0e0", shape=ellipse]; - "Cslib.Foundations.Control.Monad.Free" -> "Cslib.Foundations.Control.Monad.Free.Fold"; - "Cslib.Foundations.Lint.Basic" [style=filled, fillcolor="#e0e0e0", shape=ellipse]; - "Cslib.Foundations.Control.Monad.Time" [style=filled, fillcolor="#e0e0e0", shape=ellipse]; - "Cslib.AlgorithmsTheory.QueryModel" [shape=house]; - "Cslib.Foundations.Control.Monad.Free.Effects" -> "Cslib.AlgorithmsTheory.QueryModel"; - "Cslib.Foundations.Control.Monad.Free.Fold" -> "Cslib.AlgorithmsTheory.QueryModel"; - "Cslib.Foundations.Control.Monad.Free" [shape=ellipse]; - "Cslib.Init" -> "Cslib.Foundations.Control.Monad.Free"; - "Cslib.Init" [style=filled, fillcolor="#e0e0e0", shape=ellipse]; - "Cslib.Foundations.Lint.Basic" -> "Cslib.Init"; -} \ No newline at end of file From 77d5132dd78848a4e60b17f1e6e8c7c04de9a73a Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 04:17:15 +0100 Subject: [PATCH 076/176] remove extraneous TimeM.lean --- Cslib/Foundations/Control/Monad/Time.lean | 73 ----------------------- 1 file changed, 73 deletions(-) delete mode 100644 Cslib/Foundations/Control/Monad/Time.lean diff --git a/Cslib/Foundations/Control/Monad/Time.lean b/Cslib/Foundations/Control/Monad/Time.lean deleted file mode 100644 index a29fb2e3a..000000000 --- a/Cslib/Foundations/Control/Monad/Time.lean +++ /dev/null @@ -1,73 +0,0 @@ -/- -Copyright (c) 2025 Sorrachai Yingchareonthawornhcai. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Sorrachai Yingchareonthawornhcai, Tanner Duve --/ - -module - -public import Mathlib.Control.Monad.Writer - -@[expose] public section -/-! -# Time Monad - -`TimeM` is a monad that tracks execution time alongside computations, using natural numbers -as a simple cost model. As plain types it is isomorphic to `WriterT Nat Id`. --/ - -structure TimeM (α : Type u) where - /-- The result of the computation. -/ - ret : α - /-- The accumulated time cost. -/ - time : Nat - -namespace TimeM - -def pure {α} (a : α) : TimeM α := - ⟨a, 0⟩ - -def bind {α β} (m : TimeM α) (f : α → TimeM β) : TimeM β := - let r := f m.ret - ⟨r.ret, m.time + r.time⟩ - -instance instMonadTimeM : Monad TimeM where - pure := pure - bind := bind - -@[simp] def tick {α : Type} (a : α) (c : ℕ := 1) : TimeM α := - ⟨a, c⟩ - -scoped notation "✓" a:arg ", " c:arg => tick a c -scoped notation "✓" a:arg => tick a -- Default case with only one argument - -def tickUnit : TimeM Unit := - ✓ () -- This uses the default time increment of 1 - -@[simp] theorem time_of_pure {α} (a : α) : (pure a).time = 0 := rfl -@[simp] theorem time_of_bind {α β} (m : TimeM α) (f : α → TimeM β) : - (TimeM.bind m f).time = m.time + (f m.ret).time := rfl -@[simp] theorem time_of_tick {α} (a : α) (c : ℕ) : (tick a c).time = c := rfl -@[simp] theorem ret_bind {α β} (m : TimeM α) (f : α → TimeM β) : - (TimeM.bind m f).ret = (f m.ret).ret := rfl - --- this allow us to simplify the chain of compositions -attribute [simp] Bind.bind Pure.pure TimeM.pure - -/-- `TimeM` is (definitionally) the same as the writer monad `WriterT Nat Id`. -/ -abbrev WriterNat (α : Type) := WriterT Nat Id α - -/-- Equivalence between `TimeM α` and `WriterT Nat Id α` as plain types. -/ -def equivWriter (α : Type) : TimeM α ≃ WriterNat α where - toFun m := (m.ret, m.time) - invFun w := ⟨w.1, w.2⟩ - left_inv m := by cases m; rfl - right_inv w := by cases w; rfl - -@[simp] lemma equivWriter_toFun {α : Type} (m : TimeM α) : - (equivWriter α m : WriterNat α) = (m.ret, m.time) := rfl - -@[simp] lemma equivWriter_invFun {α : Type} (w : WriterNat α) : - (equivWriter α).invFun w = TimeM.mk w.1 w.2 := rfl - -end TimeM From efe79bfa5e5fee3242b3cfd998105541f327a346 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 04:19:13 +0100 Subject: [PATCH 077/176] Restore the OG TimeM under Lean subfolder --- .../Lean/MergeSort/MergeSort.lean | 217 ++++++++++++++++++ Cslib/AlgorithmsTheory/Lean/TimeM.lean | 109 +++++++++ 2 files changed, 326 insertions(+) create mode 100644 Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean create mode 100644 Cslib/AlgorithmsTheory/Lean/TimeM.lean diff --git a/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean b/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean new file mode 100644 index 000000000..bacd41e7d --- /dev/null +++ b/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean @@ -0,0 +1,217 @@ +/- +Copyright (c) 2025 Sorrachai Yingchareonthawornhcai. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sorrachai Yingchareonthawornhcai +-/ + +module + +public import Cslib.Algorithms.Lean.TimeM +public import Mathlib.Data.Nat.Cast.Order.Ring +public import Mathlib.Data.Nat.Lattice +public import Mathlib.Data.Nat.Log + +@[expose] public section + +/-! +# MergeSort on a list + +In this file we introduce `merge` and `mergeSort` algorithms that returns a time monad +over the list `TimeM (List α)`. The time complexity of `mergeSort` is the number of comparisons. + +-- +## Main results + +- `mergeSort_correct`: `mergeSort` permutes the list into a sorted one. +- `mergeSort_time`: The number of comparisons of `mergeSort` is at most `n*⌈log₂ n⌉`. + +-/ + +set_option autoImplicit false + +namespace Cslib.Algorithms.Lean.TimeM + +variable {α : Type} [LinearOrder α] + +/-- Merges two lists into a single list, counting comparisons as time cost. +Returns a `TimeM (List α)` where the time represents the number of comparisons performed. -/ +def merge : List α → List α → TimeM (List α) + | [], ys => return ys + | xs, [] => return xs + | x::xs', y::ys' => do + ✓ let c := (x ≤ y : Bool) + if c then + let rest ← merge xs' (y::ys') + return (x :: rest) + else + let rest ← merge (x::xs') ys' + return (y :: rest) + +/-- Sorts a list using the merge sort algorithm, counting comparisons as time cost. +Returns a `TimeM (List α)` where the time represents the total number of comparisons. -/ +def mergeSort (xs : List α) : TimeM (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 + +section Correctness + +open List + +/-- A list is sorted if it satisfies the `Pairwise (· ≤ ·)` predicate. -/ +abbrev IsSorted (l : List α) : Prop := List.Pairwise (· ≤ ·) l + +/-- `x` is a minimum element of list `l` if `x ≤ b` for all `b ∈ l`. -/ +abbrev MinOfList (x : α) (l : List α) : Prop := ∀ b ∈ l, x ≤ b + +@[grind →] +theorem mem_either_merge (xs ys : List α) (z : α) (hz : z ∈ ⟪merge xs ys⟫) : z ∈ xs ∨ z ∈ ys := by + fun_induction merge + · exact mem_reverseAux.mp hz + · left + exact hz + · grind + +theorem min_all_merge (x : α) (xs ys : List α) (hxs : MinOfList x xs) (hys : MinOfList x ys) : + MinOfList x ⟪merge xs ys⟫ := by + grind + +theorem sorted_merge {l1 l2 : List α} (hxs : IsSorted l1) (hys : IsSorted l2) : + IsSorted ⟪merge l1 l2⟫ := by + fun_induction merge l1 l2 with + | case3 => + grind [pairwise_cons] + | _ => simpa + +theorem mergeSort_sorted (xs : List α) : IsSorted ⟪mergeSort xs⟫ := by + fun_induction mergeSort xs with + | case1 x => + rcases x with _ | ⟨a, _ | ⟨b, rest⟩⟩ <;> grind + | case2 _ _ _ _ _ ih2 ih1 => exact sorted_merge ih2 ih1 + +lemma merge_perm (l₁ l₂ : List α) : ⟪merge l₁ l₂⟫ ~ l₁ ++ l₂ := by + fun_induction merge with + | case1 => simp + | case2 => simp + | case3 => + grind + +theorem mergeSort_perm (xs : List α) : ⟪mergeSort xs⟫ ~ xs := by + fun_induction mergeSort xs with + | case1 => simp + | case2 x _ _ left right ih2 ih1 => + simp only [ret_bind] + calc + ⟪merge ⟪mergeSort left⟫ ⟪mergeSort right⟫⟫ ~ + ⟪mergeSort left⟫ ++ ⟪mergeSort right⟫ := by apply merge_perm + _ ~ left++right := Perm.append ih2 ih1 + _ ~ x := by simp only [take_append_drop, Perm.refl, left, right] + +/-- MergeSort is functionally correct. -/ +theorem mergeSort_correct (xs : List α) : IsSorted ⟪mergeSort xs⟫ ∧ ⟪mergeSort xs⟫ ~ xs := + ⟨mergeSort_sorted xs, mergeSort_perm xs⟩ + +end Correctness + +section TimeComplexity + +/-- Recurrence relation for the time complexity of merge sort. +For a list of length `n`, this counts the total number of comparisons: +- Base cases: 0 comparisons for lists of length 0 or 1 +- Recursive case: split the list, sort both halves, + then merge (which takes at most `n` comparisons) -/ +def timeMergeSortRec : ℕ → ℕ +| 0 => 0 +| 1 => 0 +| n@(_+2) => timeMergeSortRec (n/2) + timeMergeSortRec ((n-1)/2 + 1) + n + +open Nat (clog) + +/-- Key Lemma: ⌈log2 ⌈n/2⌉⌉ ≤ ⌈log2 n⌉ - 1 for n > 1 -/ +@[grind →] +lemma clog2_half_le (n : ℕ) (h : n > 1) : clog 2 ((n + 1) / 2) ≤ clog 2 n - 1 := by + rw [Nat.clog_of_one_lt one_lt_two h] + grind + +/-- Same logic for the floor half: ⌈log2 ⌊n/2⌋⌉ ≤ ⌈log2 n⌉ - 1 -/ +@[grind →] +lemma clog2_floor_half_le (n : ℕ) (h : n > 1) : clog 2 (n / 2) ≤ clog 2 n - 1 := by + apply Nat.le_trans _ (clog2_half_le n h) + apply Nat.clog_monotone + grind + +private lemma some_algebra (n : ℕ) : + (n / 2 + 1) * clog 2 (n / 2 + 1) + ((n + 1) / 2 + 1) * clog 2 ((n + 1) / 2 + 1) + (n + 2) ≤ + (n + 2) * clog 2 (n + 2) := by + -- 1. Substitution: Let N = n_1 + 2 to clean up the expression + let N := n + 2 + have hN : N ≥ 2 := by omega + -- 2. Rewrite the terms using N + have t1 : n / 2 + 1 = N / 2 := by omega + have t2 : (n + 1) / 2 + 1 = (N + 1) / 2 := by omega + have t3 : n + 1 + 1 = N := by omega + let k := clog 2 N + have h_bound_l : clog 2 (N / 2) ≤ k - 1 := clog2_floor_half_le N hN + have h_bound_r : clog 2 ((N + 1) / 2) ≤ k - 1 := clog2_half_le N hN + have h_split : N / 2 + (N + 1) / 2 = N := by omega + grw [t1, t2, t3, h_bound_l, h_bound_r, ←Nat.add_mul, h_split] + exact Nat.le_refl (N * (k - 1) + N) + +/-- Upper bound function for merge sort time complexity: `T(n) = n * ⌈log₂ n⌉` -/ +abbrev T (n : ℕ) : ℕ := n * clog 2 n + +/-- Solve the recurrence -/ +theorem timeMergeSortRec_le (n : ℕ) : timeMergeSortRec n ≤ T n := by + fun_induction timeMergeSortRec with + | case1 => grind + | case2 => grind + | case3 n ih2 ih1 => + grw [ih1,ih2] + have := some_algebra n + grind [Nat.add_div_right] + +@[simp] theorem merge_ret_length_eq_sum (xs ys : List α) : + ⟪merge xs ys⟫.length = xs.length + ys.length := by + fun_induction merge with + | case3 => + grind + | _ => simp + +@[simp] theorem mergeSort_same_length (xs : List α) : + ⟪mergeSort xs⟫.length = xs.length := by + fun_induction mergeSort + · simp + · grind [merge_ret_length_eq_sum] + +@[simp] theorem merge_time (xs ys : List α) : (merge xs ys).time ≤ xs.length + ys.length := by + fun_induction merge with + | case3 => + grind + | _ => simp + +theorem mergeSort_time_le (xs : List α) : + (mergeSort xs).time ≤ timeMergeSortRec xs.length := by + fun_induction mergeSort with + | case1 => + grind + | case2 _ _ _ _ _ ih2 ih1 => + simp only [time_bind] + grw [merge_time] + simp only [mergeSort_same_length] + unfold timeMergeSortRec + grind + +/-- Time complexity of mergeSort -/ +theorem mergeSort_time (xs : List α) : + let n := xs.length + (mergeSort xs).time ≤ n * clog 2 n := by + grind [mergeSort_time_le, timeMergeSortRec_le] + +end TimeComplexity + +end Cslib.Algorithms.Lean.TimeM diff --git a/Cslib/AlgorithmsTheory/Lean/TimeM.lean b/Cslib/AlgorithmsTheory/Lean/TimeM.lean new file mode 100644 index 000000000..d890bd9a1 --- /dev/null +++ b/Cslib/AlgorithmsTheory/Lean/TimeM.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2025 Sorrachai Yingchareonthawornhcai. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sorrachai Yingchareonthawornhcai, Eric Wieser +-/ + +module + +import Cslib.Init + +@[expose] public section + +/-! + +# TimeM: Time Complexity Monad +`TimeM α` represents a computation that produces a value of type `α` and tracks its time cost. + +## Design Principles +1. **Pure inputs, timed outputs**: Functions take plain values and return `TimeM` results +2. **Time annotations are trusted**: The `time` field is NOT verified against actual cost. + You must manually ensure annotations match the algorithm's complexity in your cost model. +3. **Separation of concerns**: Prove correctness properties on `.ret`, prove complexity on `.time` + +## Cost Model +**Document your cost model explicitly** Decide and be consistent about: +- **What costs 1 unit?** (comparison, arithmetic operation, etc.) +- **What is free?** (variable lookup, pattern matching, etc.) +- **Recursive calls:** Do you charge for the call itself? + +## Notation +- **`✓`** : A tick of time, see `tick`. +- **`⟪tm⟫`** : Extract the pure value from a `TimeM` computation (notation for `tm.ret`) + +## References + +See [Danielsson2008] for the discussion. +-/ +namespace Cslib.Algorithms.Lean + +/-- A monad for tracking time complexity of computations. +`TimeM α` represents a computation that returns a value of type `α` +and accumulates a time cost (represented as a natural number). -/ +@[ext] +structure TimeM (α : Type*) where + /-- The return value of the computation -/ + ret : α + /-- The accumulated time cost of the computation -/ + time : ℕ + +namespace TimeM + +/-- Lifts a pure value into a `TimeM` computation with zero time cost. + +Prefer to use `pure` instead of `TimeM.pure`. -/ +protected def pure {α} (a : α) : TimeM α := + ⟨a, 0⟩ + +/-- Sequentially composes two `TimeM` computations, summing their time costs. + +Prefer to use the `>>=` notation. -/ +protected def bind {α β} (m : TimeM α) (f : α → TimeM β) : TimeM β := + let r := f m.ret + ⟨r.ret, m.time + r.time⟩ + +instance : Monad TimeM where + pure := TimeM.pure + bind := TimeM.bind + +@[simp, grind =] theorem ret_pure {α} (a : α) : (pure a : TimeM α).ret = a := rfl +@[simp, grind =] theorem ret_bind {α β} (m : TimeM α) (f : α → TimeM β) : + (m >>= f).ret = (f m.ret).ret := rfl +@[simp, grind =] theorem ret_map {α β} (f : α → β) (x : TimeM α) : (f <$> x).ret = f x.ret := rfl +@[simp] theorem ret_seqRight {α} (x y : TimeM α) : (x *> y).ret = y.ret := rfl +@[simp] theorem ret_seqLeft {α} (x y : TimeM α) : (x <* y).ret = x.ret := rfl +@[simp] theorem ret_seq {α β} (f : TimeM (α → β)) (x : TimeM α) : (f <*> x).ret = f.ret x.ret := rfl + +@[simp, grind =] theorem time_bind {α β} (m : TimeM α) (f : α → TimeM β) : + (m >>= f).time = m.time + (f m.ret).time := rfl +@[simp, grind =] theorem time_pure {α} (a : α) : (pure a : TimeM α).time = 0 := rfl +@[simp, grind =] theorem time_map {α β} (f : α → β) (x : TimeM α) : (f <$> x).time = x.time := rfl +@[simp] theorem time_seqRight {α} (x y : TimeM α) : (x *> y).time = x.time + y.time := rfl +@[simp] theorem time_seqLeft {α} (x y : TimeM α) : (x <* y).time = x.time + y.time := rfl +@[simp] theorem time_seq {α β} (f : TimeM (α → β)) (x : TimeM α) : + (f <*> x).time = f.time + x.time := rfl + + +instance : LawfulMonad TimeM := .mk' + (id_map := fun x => rfl) + (pure_bind := fun _ _ => by ext <;> simp) + (bind_assoc := fun _ _ _ => by ext <;> simp [Nat.add_assoc]) + +/-- Creates a `TimeM` computation with a time cost. +The time cost defaults to 1 if not provided. -/ +def tick (c : ℕ := 1) : TimeM PUnit := ⟨.unit, c⟩ + +@[simp, grind =] theorem ret_tick (c : ℕ) : (tick c).ret = () := rfl +@[simp, grind =] theorem time_tick (c : ℕ) : (tick c).time = c := rfl + +/-- `✓[c] x` adds `c` ticks, then executes `x`. -/ +macro "✓[" c:term "]" body:doElem : doElem => `(doElem| do TimeM.tick $c; $body:doElem) + +/-- `✓ x` is a shorthand for `✓[1] x`, which adds one tick and executes `x`. -/ +macro "✓" body:doElem : doElem => `(doElem| ✓[1] $body) + +/-- Notation for extracting the return value from a `TimeM` computation: `⟪tm⟫` -/ +scoped notation:max "⟪" tm "⟫" => (TimeM.ret tm) + +end TimeM +end Cslib.Algorithms.Lean From c6ed2786471c75dd03d1b2d341187f828e653693 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 04:20:57 +0100 Subject: [PATCH 078/176] Remove changes in Free/Effects.lean --- .../Control/Monad/Free/Effects.lean | 143 +++++++++++------- 1 file changed, 85 insertions(+), 58 deletions(-) diff --git a/Cslib/Foundations/Control/Monad/Free/Effects.lean b/Cslib/Foundations/Control/Monad/Free/Effects.lean index ab29e04e8..41b96905b 100644 --- a/Cslib/Foundations/Control/Monad/Free/Effects.lean +++ b/Cslib/Foundations/Control/Monad/Free/Effects.lean @@ -7,10 +7,9 @@ Authors: Tanner Duve module public import Cslib.Foundations.Control.Monad.Free -public import Mathlib.Control.Monad.Writer -public import Cslib.Foundations.Control.Monad.Time +public import Mathlib.Algebra.Group.Hom.Defs public import Mathlib.Control.Monad.Cont -public import Mathlib.Data.Nat.Basic +public import Mathlib.Control.Monad.Writer @[expose] public section @@ -21,14 +20,16 @@ This file defines several canonical instances on the free monad. ## Main definitions -- `FreeState`, `FreeWriter`, `FreeTime`, `FreeCont`: Specific effect monads +- `FreeState`, `FreeWriter`, `FreeCont`, `FreeReader`: Specific effect monads ## Implementation To execute or interpret these computations, we provide two approaches: -1. **Hand-written interpreters** (`FreeState.run`, `FreeWriter.run`, `FreeCont.run`) that directly +1. **Hand-written interpreters** (`FreeState.run`, `FreeWriter.run`, `FreeCont.run`, + `FreeReader.run`) that directly pattern-match on the tree structure -2. **Canonical interpreters** (`FreeState.toStateM`, `FreeWriter.toWriterT`, `FreeCont.toContT`) +2. **Canonical interpreters** (`FreeState.toStateM`, `FreeWriter.toWriterT`, `FreeCont.toContT`, + `FreeReader.toReaderM`) derived from the universal property via `liftM` We prove that these approaches are equivalent, demonstrating that the implementation aligns with @@ -37,7 +38,7 @@ the universal property. ## Tags -Free monad, state monad, writer monad, time monad, continuation monad +Free monad, state monad, writer monad, continuation monad -/ namespace Cslib @@ -61,9 +62,6 @@ abbrev FreeState (σ : Type u) := FreeM (StateF σ) namespace FreeState variable {σ : Type u} {α : Type v} -instance : Monad (FreeState σ) := inferInstance -instance : LawfulMonad (FreeState σ) := inferInstance - instance : MonadStateOf σ (FreeState σ) where get := .lift .get set newState := .liftBind (.set newState) (fun _ => .pure PUnit.unit) @@ -78,8 +76,6 @@ lemma get_def : (get : FreeState σ σ) = .lift .get := rfl @[simp] lemma set_def (s : σ) : (set s : FreeState σ PUnit) = .lift (.set s) := rfl -instance : MonadState σ (FreeState σ) := inferInstance - /-- Interpret `StateF` operations into `StateM`. -/ def stateInterp {α : Type u} : StateF σ α → StateM σ α | .get => MonadStateOf.get @@ -167,10 +163,7 @@ abbrev FreeWriter (ω : Type u) := FreeM (WriterF ω) namespace FreeWriter open WriterF -variable {ω : Type u} {α : Type v} - -instance : Monad (FreeWriter ω) := inferInstance -instance : LawfulMonad (FreeWriter ω) := inferInstance +variable {ω : Type u} {α : Type u} /-- Interpret `WriterF` operations into `WriterT`. -/ def writerInterp {α : Type u} : WriterF ω α → WriterT ω Id α @@ -270,44 +263,6 @@ instance [Monoid ω] : MonadWriter ω (FreeWriter ω) where end FreeWriter -/-! ### Time Monad via `FreeM` -/ - -/-- Time monad implemented as the free writer monad over `Nat`. This models computations that -emit natural-number costs while producing a result. -/ -abbrev FreeTime := FreeWriter Nat - -namespace FreeTime - -variable {α : Type} - -/-- Emit a time cost of `c` units (default `1`). -/ -def tick (c : Nat := 1) : FreeTime PUnit := - FreeWriter.tell c - -/-- Run a `FreeTime` computation, returning the result and total time cost. - -The cost is accumulated additively starting from `0`. -/ -def run : FreeTime α → α × Nat - | .pure a => (a, 0) - | .liftBind (.tell c) k => - let (a, t) := run (k .unit) - (a, c + t) - -/-- Interpret a `FreeTime` computation into the concrete time monad `TimeM`. -/ -def toTimeM (comp : FreeTime α) : TimeM α := - let (a, t) := run comp - ⟨a, t⟩ - -@[simp] -lemma run_pure (a : α) : - run (.pure a : FreeTime α) = (a, 0) := rfl - -@[simp] -lemma tick_def (c : Nat) : - tick c = (FreeWriter.tell c : FreeTime PUnit) := rfl - -end FreeTime - /-! ### Continuation Monad via `FreeM` -/ /-- Type constructor for continuation operations. -/ @@ -325,12 +280,9 @@ abbrev FreeCont (r : Type u) := FreeM (ContF r) namespace FreeCont variable {r : Type u} {α : Type v} {β : Type w} -instance : Monad (FreeCont r) := inferInstance -instance : LawfulMonad (FreeCont r) := inferInstance - /-- Interpret `ContF r` operations into `ContT r Id`. -/ def contInterp : ContF r α → ContT r Id α - | .callCC g, k => pure (g fun a => (k a).run) + | .callCC g => g /-- Convert a `FreeCont` computation into a `ContT` computation. This is the canonical interpreter derived from `liftM`. -/ @@ -394,6 +346,81 @@ lemma run_callCC (f : MonadCont.Label α (FreeCont r) β → FreeCont r α) (k : end FreeCont +/-- Type constructor for reader operations. -/ +inductive ReaderF (σ : Type u) : Type u → Type u where + | read : ReaderF σ σ + +/-- Reader monad via the `FreeM` monad -/ +abbrev FreeReader (σ) := FreeM (ReaderF σ) + +namespace FreeReader + +variable {σ : Type u} {α : Type u} + +instance : MonadReaderOf σ (FreeReader σ) where + read := .lift .read + +@[simp] +lemma read_def : (read : FreeReader σ σ) = .lift .read := rfl + +instance : MonadReader σ (FreeReader σ) := inferInstance + +/-- Interpret `ReaderF` operations into `ReaderM`. -/ +def readInterp {α : Type u} : ReaderF σ α → ReaderM σ α + | .read => MonadReaderOf.read + +/-- Convert a `FreeReader` computation into a `ReaderM` computation. This is the canonical +interpreter derived from `liftM`. -/ +def toReaderM {α : Type u} (comp : FreeReader σ α) : ReaderM σ α := + comp.liftM readInterp + +/-- `toReaderM` is the unique interpreter extending `readInterp`. -/ +theorem toReaderM_unique {α : Type u} (g : FreeReader σ α → ReaderM σ α) + (h : Interprets readInterp g) : g = toReaderM := h.eq + +/-- Run a reader computation -/ +def run (comp : FreeReader σ α) (s₀ : σ) : α := + match comp with + | .pure a => a + | .liftBind ReaderF.read a => run (a s₀) s₀ + +/-- +The canonical interpreter `toReaderM` derived from `liftM` agrees with the hand-written +recursive interpreter `run` for `FreeReader` -/ +@[simp] +theorem run_toReaderM {α : Type u} (comp : FreeReader σ α) (s : σ) : + (toReaderM comp).run s = run comp s := by + induction comp generalizing s with + | pure a => rfl + | liftBind op cont ih => + cases op; apply ih + +@[simp] +lemma run_pure (a : α) (s₀ : σ) : + run (.pure a : FreeReader σ α) s₀ = a := rfl + +@[simp] +lemma run_read (k : σ → FreeReader σ α) (s₀ : σ) : + run (liftBind .read k) s₀ = run (k s₀) s₀ := rfl + +instance instMonadWithReaderOf : MonadWithReaderOf σ (FreeReader σ) where + withReader {α} f m := + let rec go : FreeReader σ α → FreeReader σ α + | .pure a => .pure a + | .liftBind .read cont => + .liftBind .read fun s => go (cont (f s)) + go m + +@[simp] theorem run_withReader (f : σ → σ) (m : FreeReader σ α) (s : σ) : + run (withTheReader σ f m) s = run m (f s) := by + induction m generalizing s with + | pure a => rfl + | liftBind op cont ih => + cases op + simpa [withTheReader, instMonadWithReaderOf, run] using (ih (f s) s) + +end FreeReader + end FreeM end Cslib From d6076ff45a372484be0337a733156bd59c75835d Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 04:25:51 +0100 Subject: [PATCH 079/176] Check toplevel file --- Cslib.lean | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Cslib.lean b/Cslib.lean index 94ef01771..51cbaddb9 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -4,6 +4,8 @@ public import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert public import Cslib.AlgorithmsTheory.Algorithms.ListInsertionSort public import Cslib.AlgorithmsTheory.Algorithms.ListLinearSearch public import Cslib.AlgorithmsTheory.Algorithms.MergeSort +public import Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort +public import Cslib.AlgorithmsTheory.Lean.TimeM public import Cslib.AlgorithmsTheory.QueryModel public import Cslib.Computability.Automata.Acceptors.Acceptor public import Cslib.Computability.Automata.Acceptors.OmegaAcceptor From e4fc337c0bc6a5c225969683e1a0287ed87039d5 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 04:30:47 +0100 Subject: [PATCH 080/176] Changes to import paths of TimeM --- Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean b/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean index bacd41e7d..20cecdfd8 100644 --- a/Cslib/AlgorithmsTheory/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 From f9ab5442dbf5aef04d22e52300af86e0496f34fd Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 05:34:51 +0100 Subject: [PATCH 081/176] Only mergeSort_complexity remains --- Cslib.lean | 1 - .../Algorithms/ListInsertionSort.lean | 11 +- .../Algorithms/ListOrderedInsert.lean | 37 ++-- .../Algorithms/MergeSort.lean | 193 +++++++++++++++--- 4 files changed, 198 insertions(+), 44 deletions(-) diff --git a/Cslib.lean b/Cslib.lean index 51cbaddb9..5fd4b6a96 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -44,7 +44,6 @@ 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.Control.Monad.Time public import Cslib.Foundations.Data.FinFun public import Cslib.Foundations.Data.HasFresh public import Cslib.Foundations.Data.Nat.Segment diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index b0ee6f898..5e6f30f39 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -40,7 +40,7 @@ lemma insertionSort_time_compares [LinearOrder α] (head : α) (tail : List α) ((insertOrd head ((insertionSort tail).eval (sortModel α))).time (sortModel α)).compares := by have h := congrArg SortOpsCost.compares (Prog.time.bind (M := sortModel α) (insertionSort tail) (fun rest => insertOrd head rest)) - simp only [HAdd.hAdd, acsSortOpsCost, Add.add] at h + simp only [HAdd.hAdd, Add.add] at h simpa [insertionSort] using h lemma insertionSort_time_inserts [LinearOrder α] (head : α) (tail : List α) : @@ -49,7 +49,7 @@ lemma insertionSort_time_inserts [LinearOrder α] (head : α) (tail : List α) : ((insertOrd head ((insertionSort tail).eval (sortModel α))).time (sortModel α)).inserts := by have h := congrArg SortOpsCost.inserts (Prog.time.bind (M := sortModel α) (insertionSort tail) (fun rest => insertOrd head rest)) - simp only [HAdd.hAdd, acsSortOpsCost, Add.add] at h + simp only [HAdd.hAdd, Add.add] at h simpa [insertionSort] using h lemma insertionSort_length [LinearOrder α] (l : List α) : @@ -67,13 +67,12 @@ theorem insertionSort_complexity [LinearOrder α] (l : List α) : ≤ ⟨l.length * (l.length + 1), (l.length + 1) * (l.length + 2)⟩ := by induction l with | nil => - simp only [partialOrderSortOps, not_and, not_le, insertionSort, FreeM.pure_eq_pure, sortModel, - Bool.if_false_right, Bool.and_true, time.eq_1, List.length_nil, zero_add, mul_one, one_mul, - nonpos_iff_eq_zero] + simp only [insertionSort, FreeM.pure_eq_pure, sortModel, + Bool.if_false_right, Bool.and_true, time.eq_1, List.length_nil, zero_add, mul_one, one_mul] tauto | cons head tail ih => have h := insertOrd_complexity_upper_bound ((insertionSort tail).eval (sortModel α)) head - simp_all only [partialOrderSortOps, not_and, not_le, List.length_cons, insertionSort_length] + simp_all only [List.length_cons, insertionSort_length] obtain ⟨ih₁,ih₂⟩ := ih obtain ⟨h₁,h₂⟩ := h refine ⟨?_, ?_⟩ diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index c301cb092..da0fe1034 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -35,7 +35,7 @@ structure SortOpsCost where instance zeroSortOps : Zero SortOpsCost := ⟨0,0⟩ -@[simp] +@[simp, grind] instance partialOrderSortOps : PartialOrder SortOpsCost where le | ⟨c₁, i₁⟩, ⟨c₂, i₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ le_refl := by @@ -65,19 +65,20 @@ instance acsSortOpsCost : AddCommMonoid SortOpsCost where add_assoc := by intro a b c simp only [HAdd.hAdd] - simp [add, instAddNat, Nat.add_assoc] + simp [add, Nat.add_assoc] add_comm := by intro a b simp only [HAdd.hAdd] - simp [add, instAddNat, Nat.add_comm] + simp [add, Nat.add_comm] zero_add := by intro ⟨c, i⟩ - simp only [HAdd.hAdd, add] - simp [instAddNat] + simp only [HAdd.hAdd, Add.add, add] + simp add_zero := by intro ⟨c, i⟩ simp only [HAdd.hAdd, add] - simp [instAddNat] + simp [Add.add] + nsmul := nsmul nsmul_zero := by intro x @@ -119,7 +120,7 @@ lemma SortModel_addComponents (m₁ m₂ m₃ : SortOpsCost) : m₁ + m₂ = m₃ ↔ m₁.compares + m₂.compares = m₃.compares ∧ m₁.inserts + m₂.inserts = m₃.inserts := by - simp only [HAdd.hAdd, instAddNat] + simp only [HAdd.hAdd] aesop @[simp] @@ -238,7 +239,7 @@ lemma bind_compares {α} (x tail head) [LinearOrder α] : (Prog.time.bind (M := sortModel α) (op := insertOrd x tail) (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) - simp only [acsSortOpsCost, zeroSortOps, FreeM.bind_eq_bind, sortModel, Bool.if_false_right, + simp only [FreeM.bind_eq_bind, sortModel, Bool.if_false_right, Bool.and_true, HAdd.hAdd, time, eval, SortModel_add_compares] at h simp only [Add.add] at h simp_all only [sortModel, Bool.if_false_right, Bool.and_true] @@ -255,26 +256,31 @@ lemma bind_inserts {α} (x tail head) [LinearOrder α] : (Prog.time.bind (M := sortModel α) (op := insertOrd x tail) (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) - simp only [HAdd.hAdd, acsSortOpsCost, bind, sortModel, Bool.if_false_right, + simp only [HAdd.hAdd, bind, sortModel, Bool.if_false_right, Bool.and_true, SortModel_add_inserts, time, eval] at h simp only [Add.add] at h exact h +@[simp] lemma cost_cmpLT_compares [LinearOrder α] : ((sortModel α).2 (cmpLT head x)).compares = 1 := by simp [sortModel] +@[simp] lemma cost_cmpLT_inserts [LinearOrder α] : ((sortModel α).2 (cmpLT head x)).inserts = 0 := by simp [sortModel] +@[simp] lemma cost_insertHead_compares [LinearOrder α] : ((sortModel α).2 (insertHead x l)).compares = 0 := by simp [sortModel] +@[simp] lemma cost_insertHead_inserts [LinearOrder α] : ((sortModel α).2 (insertHead x l)).inserts = 1 := by simp [sortModel] -lemma insertOrd_complexity_upper_bound [LinearOrder α] : + +theorem insertOrd_complexity_upper_bound [LinearOrder α] : ∀ (l : List α) (x : α), (insertOrd x l).time (sortModel α) ≤ ⟨l.length, l.length + 1⟩ := by intro l x @@ -282,8 +288,8 @@ lemma insertOrd_complexity_upper_bound [LinearOrder α] : | nil => simp [insertOrd, sortModel] | cons head tail ih => - simp_all only [partialOrderSortOps, not_and, not_le, insertOrd, FreeM.lift_def, - FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, time.eq_2, List.length_cons] + simp_all only [insertOrd, FreeM.lift_def, FreeM.bind_eq_bind, FreeM.liftBind_bind, + FreeM.pure_bind, time.eq_2, List.length_cons] obtain ⟨ih_compares, ih_inserts⟩ := ih split_ifs with h_head · simp only [HAdd.hAdd, Add.add, add, Nat.add] @@ -295,8 +301,11 @@ lemma insertOrd_complexity_upper_bound [LinearOrder α] : · clear ih_compares rw [cost_cmpLT_inserts, bind_inserts] grind - · simp only [HAdd.hAdd, Add.add, add, Nat.add, sortModel] - grind + · simp only [HAdd.hAdd, sortModel, Bool.if_false_right, Bool.and_true, time] + simp only [Add.add, add, add_zero, zero_add, Nat.add_eq] + refine ⟨?_, ?_⟩ + · grind + · grind diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 5115751a0..1adc91b4a 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -232,26 +232,43 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : (mergeSortNaive xs).length = xs.length := by - by_cases h₂ : xs.length < 2 - · unfold mergeSortNaive - simp [h₂] - · unfold mergeSortNaive - simp only [h₂, ↓reduceIte] - induction h : xs.length using Nat.strong_induction_on generalizing xs with - | h n ih => - rw [mergeNaive_length] - have h₁ := ih ((List.take (n / 2) xs)).length (by simp [List.length_take]; grind) - have h₂ := ih ((List.drop (n / 2) xs)).length (by simp [List.length_drop]; grind) - specialize h₁ (List.take (n / 2) xs) - specialize h₂ (List.drop (n / 2) xs) - by_cases hdrop : (List.drop (n / 2) xs).length < 2 - <;> by_cases htake : (List.take (n / 2) xs).length < 2 - · - done - · done - · done - · specialize h₁ htake rfl - done + let P : Nat → Prop := + fun n => ∀ ys : List α, ys.length = n → (mergeSortNaive ys).length = ys.length + have hP : P xs.length := by + refine Nat.strong_induction_on xs.length ?_ + intro n ih ys hlen + by_cases hlt : ys.length < 2 + · simp [mergeSortNaive, hlt] + · have hge : 2 ≤ ys.length := le_of_not_gt hlt + have hpos : 0 < ys.length := lt_of_lt_of_le (by decide : 0 < (2 : Nat)) hge + have hhalf_lt : ys.length / 2 < ys.length := by + have htwo : 1 < (2 : Nat) := by decide + simpa using Nat.div_lt_self hpos htwo + have htake_lt : (ys.take (ys.length / 2)).length < ys.length := by + have htake_le : (ys.take (ys.length / 2)).length ≤ ys.length / 2 := by + simp [List.length_take] + exact lt_of_le_of_lt htake_le hhalf_lt + have hdrop_lt : (ys.drop (ys.length / 2)).length < ys.length := by + have hhalf_pos : 0 < ys.length / 2 := by + have htwo : 0 < (2 : Nat) := by decide + simpa using Nat.div_pos hge htwo + have hsub : ys.length - ys.length / 2 < ys.length := Nat.sub_lt hpos hhalf_pos + simpa [List.length_drop] using hsub + have hleft : + (mergeSortNaive (ys.take (ys.length / 2))).length = + (ys.take (ys.length / 2)).length := by + exact ih (ys.take (ys.length / 2)).length + (by simpa [hlen] using htake_lt) (ys.take (ys.length / 2)) rfl + have hright : + (mergeSortNaive (ys.drop (ys.length / 2))).length = + (ys.drop (ys.length / 2)).length := by + exact ih (ys.drop (ys.length / 2)).length + (by simpa [hlen] using hdrop_lt) (ys.drop (ys.length / 2)) rfl + have hdiv_le : ys.length / 2 ≤ ys.length := Nat.div_le_self _ _ + rw [mergeSortNaive] + simp [hlt, mergeNaive_length, hleft, hright, List.length_take, List.length_drop, + Nat.min_eq_left hdiv_le, Nat.add_sub_of_le hdiv_le] + exact hP xs rfl lemma mergeSort_length [LinearOrder α] (xs : List α) : ((mergeSort xs).eval (sortModel α)).length = xs.length := by @@ -259,9 +276,139 @@ lemma mergeSort_length [LinearOrder α] (xs : List α) : apply mergeSortNaive_length +lemma mergeNaive_mem [LinearOrder α] (xs ys : List α) : + x ∈ mergeNaive xs ys → x ∈ xs ∨ x ∈ ys := by + fun_induction mergeNaive + · simp + · simp + · expose_names + intro h + simp only [List.mem_cons] at h + obtain h | h := h + · left + simp [h] + · simp only [rest] at h + specialize ih1 h + obtain ih | ih := ih1 + · simp only [List.mem_cons] + tauto + · right; exact ih + · expose_names + intro h + simp only [List.mem_cons, rest] at h + obtain h | h := h + · simp only [List.mem_cons] + tauto + · specialize ih1 h + tauto + lemma mergeNaive_sorted_sorted [LinearOrder α] (xs ys : List α) - (hxs_mono : Monotone xs.get) (hys_mono : Monotone ys.get) : - Monotone (mergeNaive xs ys).get := by - sorry + (hxs_mono : xs.Pairwise (· ≤ ·)) (hys_mono : ys.Pairwise (· ≤ ·)) : + (mergeNaive xs ys).Pairwise (· ≤ ·) := by + induction xs generalizing ys with + | nil => + simp_all [mergeNaive] + | cons xhead xtail x_ih => + induction ys with + | nil => + simp_all [mergeNaive] + | cons yhead ytail y_ih => + simp only [mergeNaive] + by_cases hxy : xhead < yhead + · simp only [hxy, ↓reduceIte, List.pairwise_cons] + refine ⟨?_, ?_⟩ + · intro a a_mem + apply mergeNaive_mem at a_mem + simp_all only [List.pairwise_cons, List.mem_cons, forall_const] + obtain ⟨left, right⟩ := hxs_mono + obtain ⟨left_1, right_1⟩ := hys_mono + cases a_mem with + | inl h => simp_all only + | inr h_1 => + cases h_1 with + | inl h => + subst h + grind + | inr h_2 => grind + · simp_all + · simp only [hxy, ↓reduceIte, List.pairwise_cons] + refine ⟨?_, ?_⟩ + · intro a a_mem + apply mergeNaive_mem at a_mem + simp_all only [List.pairwise_cons, not_lt, List.mem_cons, forall_const] + obtain ⟨left, right⟩ := hxs_mono + obtain ⟨left_1, right_1⟩ := hys_mono + cases a_mem with + | inl h => + cases h with + | inl h_1 => + subst h_1 + simp_all only + | inr h_2 => grind + | inr h_1 => simp_all only + · simp_all + +lemma merge_sorted_sorted [LinearOrder α] (xs ys : List α) + (hxs_mono : xs.Pairwise (· ≤ ·)) (hys_mono : ys.Pairwise (· ≤ ·)) : + ((merge xs ys).eval (sortModel α)).Pairwise (· ≤ ·) := by + rw [merge_is_mergeNaive] + apply mergeNaive_sorted_sorted + all_goals assumption + +lemma mergeSortNaive_sorted [LinearOrder α] (xs : List α) : + (mergeSortNaive xs).Pairwise (· ≤ ·) := by + let P : Nat → Prop := + fun n => ∀ ys : List α, ys.length = n → (mergeSortNaive ys).Pairwise (· ≤ ·) + have hP : P xs.length := by + refine Nat.strong_induction_on (n := xs.length) ?_ + intro n ih ys hlen + by_cases hlt : ys.length < 2 + · cases ys with + | nil => + simp [mergeSortNaive] + | cons y ys' => + cases ys' with + | nil => + simp [mergeSortNaive] + | cons z zs => + exact (Nat.not_lt_of_ge (by simp) hlt).elim + · have hge : 2 ≤ ys.length := le_of_not_gt hlt + have hpos : 0 < ys.length := lt_of_lt_of_le (by decide : 0 < (2 : Nat)) hge + have hhalf_lt : ys.length / 2 < ys.length := by + have htwo : 1 < (2 : Nat) := by decide + simpa using Nat.div_lt_self hpos htwo + have htake_lt : (ys.take (ys.length / 2)).length < ys.length := by + have htake_le : (ys.take (ys.length / 2)).length ≤ ys.length / 2 := by + simp [List.length_take] + exact lt_of_le_of_lt htake_le hhalf_lt + have hdrop_lt : (ys.drop (ys.length / 2)).length < ys.length := by + have hhalf_pos : 0 < ys.length / 2 := by + have htwo : 0 < (2 : Nat) := by decide + simpa using Nat.div_pos hge htwo + have hsub : ys.length - ys.length / 2 < ys.length := Nat.sub_lt hpos hhalf_pos + simpa [List.length_drop] using hsub + have hleft : + (mergeSortNaive (ys.take (ys.length / 2))).Pairwise (· ≤ ·) := by + exact ih (ys.take (ys.length / 2)).length + (by simpa [hlen] using htake_lt) (ys.take (ys.length / 2)) rfl + have hright : + (mergeSortNaive (ys.drop (ys.length / 2))).Pairwise (· ≤ ·) := by + exact ih (ys.drop (ys.length / 2)).length + (by simpa [hlen] using hdrop_lt) (ys.drop (ys.length / 2)) rfl + rw [mergeSortNaive] + simpa [hlt] using mergeNaive_sorted_sorted + (mergeSortNaive (ys.take (ys.length / 2))) + (mergeSortNaive (ys.drop (ys.length / 2))) hleft hright + exact hP xs rfl + +theorem mergeSort_sorted [LinearOrder α] (xs : List α) : + ((mergeSort xs).eval (sortModel α)).Pairwise (· ≤ ·) := by + rw [mergeSort_is_mergeSortNaive] + apply mergeSortNaive_sorted + + +theorem mergeSort_complexity [LinearOrder α] (xs : List α) : + ((mergeSort xs).time (sortModel α)) ≤ 1 + ((Nat.log 2 xs.length) * (xs.length)) := by + sorry end Cslib.Algorithms From 764749ac20c914b004d36ea7b5f8cb5512f86431 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 06:18:22 +0100 Subject: [PATCH 082/176] Build okay --- .../Algorithms/MergeSort.lean | 160 +++++++++++++----- 1 file changed, 116 insertions(+), 44 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 1adc91b4a..65a712fac 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -7,19 +7,17 @@ Authors: Tanner Duve module public import Cslib.AlgorithmsTheory.QueryModel +public import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert @[expose] public section namespace Cslib.Algorithms -inductive SortOps (α : Type) : Type → Type where - | cmpLT (x : α) (y : α): SortOps α Bool - | insertHead (l : List α) (x : α) : SortOps α (List α) open SortOps -def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where +def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where evalQuery q := match q with | .cmpLT x y => @@ -34,10 +32,10 @@ def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where | .insertHead _ _ => 1 @[simp] -lemma sortModel_eval_1 [LinearOrder α] (y x : α) : - y ≤ x → (sortModel α).evalQuery (cmpLT x y) = false := by +lemma sortModelNat_eval_1 [LinearOrder α] (y x : α) : + y ≤ x → (sortModelNat α).evalQuery (cmpLT x y) = false := by intro h - simp only [sortModel, Bool.if_false_right, Bool.and_true, decide_eq_false_iff_not, not_lt] + simp only [sortModelNat, Bool.if_false_right, Bool.and_true, decide_eq_false_iff_not, not_lt] exact h /-- Merge two sorted lists using comparisons in the query monad. -/ def mergeNaive [LinearOrder α] (x y : List α) : List α := @@ -74,65 +72,67 @@ def merge (x y : List α) : Prog (SortOps α) (List α) := do lemma merge_bind_pure_insert_x [LinearOrder α] (x y : α) (xs ys : List α) : (Prog.time - (FreeM.bind (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest))) (sortModel α)) - = (merge xs (y :: ys)).time (sortModel α) := by - have h := Prog.time.bind (sortModel α) (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest)) + (FreeM.bind (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest))) (sortModelNat α)) + = (merge xs (y :: ys)).time (sortModelNat α) := by + have h := Prog.time.bind (sortModelNat α) (merge xs (y :: ys)) + (fun rest => FreeM.pure (x :: rest)) have h' : Prog.time (FreeM.bind (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest))) - (sortModel α) + 1 = (merge xs (y :: ys)).time (sortModel α) + 1 := by + (sortModelNat α) + 1 = (merge xs (y :: ys)).time (sortModelNat α) + 1 := by simpa using h exact Nat.add_right_cancel h' lemma merge_bind_pure_insert_y [LinearOrder α] (x y : α) (xs ys : List α) : (Prog.time - (FreeM.bind (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest))) (sortModel α)) - = (merge (x :: xs) ys).time (sortModel α) := by - have h := Prog.time.bind (sortModel α) (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest)) + (FreeM.bind (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest))) (sortModelNat α)) + = (merge (x :: xs) ys).time (sortModelNat α) := by + have h := Prog.time.bind (sortModelNat α) (merge (x :: xs) ys) + (fun rest => FreeM.pure (y :: rest)) have h' : Prog.time (FreeM.bind (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest))) - (sortModel α) + 1 = (merge (x :: xs) ys).time (sortModel α) + 1 := by + (sortModelNat α) + 1 = (merge (x :: xs) ys).time (sortModelNat α) + 1 := by simpa using h exact Nat.add_right_cancel h' lemma merge_timeComplexity [LinearOrder α] (x y : List α) : - (merge x y).time (sortModel α) ≤ x.length + y.length + 1:= by + (merge x y).time (sortModelNat α) ≤ x.length + y.length := by fun_induction merge · simp · simp · expose_names - simp only [bind, FreeM.lift_def, pure, FreeM.liftBind_bind, FreeM.pure_bind, sortModel, + simp only [bind, FreeM.lift_def, pure, FreeM.liftBind_bind, FreeM.pure_bind, sortModelNat, Bool.if_false_right, Bool.and_true, Prog.time.eq_2, decide_eq_true_eq, List.length_cons] split_ifs with hxy · have hbind := merge_bind_pure_insert_x x y xs' ys' - simp only [sortModel, Bool.if_false_right, Bool.and_true] at hbind + simp only [sortModelNat, Bool.if_false_right, Bool.and_true] at hbind rw [hbind] have hih : - (merge xs' (y :: ys')).time (sortModel α) ≤ - xs'.length + (y :: ys').length + 1 := by + (merge xs' (y :: ys')).time (sortModelNat α) ≤ + xs'.length + (y :: ys').length := by simpa using ih2 have h := Nat.add_le_add_left hih 1 simpa [List.length_cons, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using h · have hbind := merge_bind_pure_insert_y x y xs' ys' - simp only [sortModel, Bool.if_false_right, Bool.and_true] at hbind + simp only [sortModelNat, Bool.if_false_right, Bool.and_true] at hbind rw [hbind] have hih : - (merge (x :: xs') ys').time (sortModel α) ≤ - (x :: xs').length + ys'.length + 1 := by + (merge (x :: xs') ys').time (sortModelNat α) ≤ + (x :: xs').length + ys'.length := by simpa using ih1 have h := Nat.add_le_add_left hih 1 simpa [List.length_cons, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using h lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : - (merge x y).eval (sortModel α) = mergeNaive x y := by + (merge x y).eval (sortModelNat α) = mergeNaive x y := by fun_induction mergeNaive · simp [merge] · simp [merge] · expose_names - simp_all [Prog.eval, merge, rest, sortModel] + simp_all [Prog.eval, merge, rest, sortModelNat] · expose_names simp_all [Prog.eval, merge, rest] lemma merge_length [LinearOrder α] (x y : List α) : - ((merge x y).eval (sortModel α)).length = x.length + y.length := by + ((merge x y).eval (sortModelNat α)).length = x.length + y.length := by rw [merge_is_mergeNaive] apply mergeNaive_length @@ -154,10 +154,10 @@ def mergeSortNaive [LinearOrder α] (xs : List α) : List α := mergeNaive sortedLeft sortedRight lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : - (mergeSort xs).eval (sortModel α) = mergeSortNaive xs := by + (mergeSort xs).eval (sortModelNat α) = mergeSortNaive xs := by classical let P : Nat → Prop := - fun n => ∀ xs, xs.length = n → (mergeSort xs).eval (sortModel α) = mergeSortNaive xs + fun n => ∀ xs, xs.length = n → (mergeSort xs).eval (sortModelNat α) = mergeSortNaive xs have hP : P xs.length := by refine Nat.strong_induction_on (n := xs.length) ?_ intro n ih xs hlen @@ -186,42 +186,42 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : have hsub : xs.length - half < xs.length := Nat.sub_lt hpos hhalf_pos simpa [right, List.length_drop, half] using hsub have hleft : - (mergeSort left).eval (sortModel α) = mergeSortNaive left := + (mergeSort left).eval (sortModelNat α) = mergeSortNaive left := (ih left.length (by simpa [hlen] using hleft_lt_len)) left rfl have hright : - (mergeSort right).eval (sortModel α) = mergeSortNaive right := + (mergeSort right).eval (sortModelNat α) = mergeSortNaive right := (ih right.length (by simpa [hlen] using hright_lt_len)) right rfl have hleft' : - FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) + FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (mergeSort (xs.take (xs.length / 2))) = mergeSortNaive (xs.take (xs.length / 2)) := by simpa [left, half, Prog.eval, Id.run] using hleft have hright' : - FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) + FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (mergeSort (xs.drop (xs.length / 2))) = mergeSortNaive (xs.drop (xs.length / 2)) := by simpa [right, half, Prog.eval, Id.run] using hright have hmerge (a b : List α) : - FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) (merge a b) = + FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b) = mergeNaive a b := by simpa [Prog.eval, Id.run] using (merge_is_mergeNaive (α := α) a b) nth_rewrite 1 [mergeSort] nth_rewrite 1 [mergeSortNaive] simp only [hlt, if_false, Prog.eval, Id.run, bind, pure, FreeM.liftM_bind] set a := - FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) + FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (mergeSort (List.take (xs.length / 2) xs)) set b := - FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) + FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (mergeSort (List.drop (xs.length / 2) xs)) calc - FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) + FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (merge - (FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) + (FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (mergeSort (List.take (xs.length / 2) xs))) - (FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) + (FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (mergeSort (List.drop (xs.length / 2) xs)))) = - FreeM.liftM (m := Id) (fun {ι} q => (sortModel α).evalQuery q) (merge a b) := by + FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b) := by simp [a, b] _ = mergeNaive a b := hmerge a b _ = mergeNaive (mergeSortNaive (List.take (xs.length / 2) xs)) @@ -271,7 +271,7 @@ lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : exact hP xs rfl lemma mergeSort_length [LinearOrder α] (xs : List α) : - ((mergeSort xs).eval (sortModel α)).length = xs.length := by + ((mergeSort xs).eval (sortModelNat α)).length = xs.length := by rw [mergeSort_is_mergeSortNaive] apply mergeSortNaive_length @@ -351,7 +351,7 @@ lemma mergeNaive_sorted_sorted [LinearOrder α] (xs ys : List α) lemma merge_sorted_sorted [LinearOrder α] (xs ys : List α) (hxs_mono : xs.Pairwise (· ≤ ·)) (hys_mono : ys.Pairwise (· ≤ ·)) : - ((merge xs ys).eval (sortModel α)).Pairwise (· ≤ ·) := by + ((merge xs ys).eval (sortModelNat α)).Pairwise (· ≤ ·) := by rw [merge_is_mergeNaive] apply mergeNaive_sorted_sorted all_goals assumption @@ -403,12 +403,84 @@ lemma mergeSortNaive_sorted [LinearOrder α] (xs : List α) : exact hP xs rfl theorem mergeSort_sorted [LinearOrder α] (xs : List α) : - ((mergeSort xs).eval (sortModel α)).Pairwise (· ≤ ·) := by + ((mergeSort xs).eval (sortModelNat α)).Pairwise (· ≤ ·) := by rw [mergeSort_is_mergeSortNaive] apply mergeSortNaive_sorted +section TimeComplexity +/- I am explicitly borrowing Sorrachai's code, which can be found in +`Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort`. But the recurrence is not needed-/ + +open Nat (clog) + +/-- Key Lemma: ⌈log2 ⌈n/2⌉⌉ ≤ ⌈log2 n⌉ - 1 for n > 1 -/ +@[grind →] +lemma clog2_half_le (n : ℕ) (h : n > 1) : clog 2 ((n + 1) / 2) ≤ clog 2 n - 1 := by + rw [Nat.clog_of_one_lt one_lt_two h] + grind + +/-- Same logic for the floor half: ⌈log2 ⌊n/2⌋⌉ ≤ ⌈log2 n⌉ - 1 -/ +@[grind →] +lemma clog2_floor_half_le (n : ℕ) (h : n > 1) : clog 2 (n / 2) ≤ clog 2 n - 1 := by + apply Nat.le_trans _ (clog2_half_le n h) + apply Nat.clog_monotone + grind + +@[grind .] +private lemma some_algebra (n : ℕ) : + (n / 2 + 1) * clog 2 (n / 2 + 1) + ((n + 1) / 2 + 1) * clog 2 ((n + 1) / 2 + 1) + (n + 2) ≤ + (n + 2) * clog 2 (n + 2) := by + -- 1. Substitution: Let N = n_1 + 2 to clean up the expression + let N := n + 2 + have hN : N ≥ 2 := by omega + -- 2. Rewrite the terms using N + have t1 : n / 2 + 1 = N / 2 := by omega + have t2 : (n + 1) / 2 + 1 = (N + 1) / 2 := by omega + have t3 : n + 1 + 1 = N := by omega + let k := clog 2 N + have h_bound_l : clog 2 (N / 2) ≤ k - 1 := clog2_floor_half_le N hN + have h_bound_r : clog 2 ((N + 1) / 2) ≤ k - 1 := clog2_half_le N hN + have h_split : N / 2 + (N + 1) / 2 = N := by omega + grw [t1, t2, t3, h_bound_l, h_bound_r, ←Nat.add_mul, h_split] + exact Nat.le_refl (N * (k - 1) + 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 + simp only [T] + exact Nat.mul_le_mul h_ij (Nat.clog_monotone 2 h_ij) theorem mergeSort_complexity [LinearOrder α] (xs : List α) : - ((mergeSort xs).time (sortModel α)) ≤ 1 + ((Nat.log 2 xs.length) * (xs.length)) := by - sorry + ((mergeSort xs).time (sortModelNat α)) ≤ (T (xs.length)) := by + fun_induction mergeSort + · simp [T] + · expose_names + rw [Prog.time.bind, Prog.time.bind] + have hmerge := merge_timeComplexity + ((mergeSort left).eval (sortModelNat α)) + ((mergeSort right).eval (sortModelNat α)) + grw [hmerge, ih1, ih2, mergeSort_length, mergeSort_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 From 04582c1cad67dc6e0e26359f7b4d2b9bcc99c527 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 06:38:56 +0100 Subject: [PATCH 083/176] Done --- Cslib.lean | 2 + .../Algorithms/ListLinearSearch.lean | 13 +- .../Algorithms/ListOrderedInsert.lean | 124 +----- .../Algorithms/MergeSort.lean | 25 +- .../Models/ListComparisonSearch.lean | 35 ++ .../Models/ListComparisonSort.lean | 171 +++++++++ CslibTests/QueryModel/ProgExamples.lean | 357 +----------------- 7 files changed, 219 insertions(+), 508 deletions(-) create mode 100644 Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean create mode 100644 Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean diff --git a/Cslib.lean b/Cslib.lean index 5fd4b6a96..45dbf4b15 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -6,6 +6,8 @@ public import Cslib.AlgorithmsTheory.Algorithms.ListLinearSearch 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 diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index f9c37b944..49d73d0ca 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -7,6 +7,7 @@ Authors: Shreyas Srinivas module public import Cslib.AlgorithmsTheory.QueryModel +public import Cslib.AlgorithmsTheory.Models.ListComparisonSearch public import Mathlib @[expose] public section @@ -18,18 +19,6 @@ namespace Algorithms open Prog -inductive ListSearch (α : Type) : Type → Type where - | compare (a : List α) (val : α) : ListSearch α Bool - - -def ListSearch_Nat [DecidableEq α] : Model (ListSearch α) ℕ where - evalQuery q := - match q with - | .compare l x => l.head? = some x - cost q := - match q with - | .compare _ _ => 1 - open ListSearch in def listLinearSearch (l : List α) (x : α) : Prog (ListSearch α) Bool := do match l with diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index da0fe1034..5a99e45b9 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -7,140 +7,18 @@ Authors: Shreyas Srinivas module public import Cslib.AlgorithmsTheory.QueryModel +public import Cslib.AlgorithmsTheory.Models.ListComparisonSort public import Mathlib @[expose] public section - namespace Cslib - namespace Algorithms open Prog -/-- The Model for comparison sorting natural-number registers. --/ -inductive SortOps (α : Type) : Type → Type where - | cmpLT (x : α) (y : α): SortOps α Bool - | insertHead (l : List α) (x : α) : SortOps α (List α) open SortOps -@[ext, grind] -structure SortOpsCost where - compares : ℕ - inserts : ℕ - - -@[simp, grind] -instance zeroSortOps : Zero SortOpsCost := ⟨0,0⟩ - - -@[simp, grind] -instance partialOrderSortOps : PartialOrder SortOpsCost where - le | ⟨c₁, i₁⟩, ⟨c₂, i₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ - le_refl := by - intro c - simp only [le_refl, and_self] - le_trans a b c := by - simp only [and_imp] - intro ab_comps ab_inserts bc_comps bc_inserts - refine ⟨?_, ?_⟩ - all_goals solve_by_elim [Nat.le_trans] - le_antisymm := by - intro ⟨a_comps, a_inserts⟩ ⟨b_comps, b_inserts⟩ - simp only [SortOpsCost.mk.injEq, and_imp] - intro ab_comps ab_inserts ba_comps ba_inserts - refine ⟨?_, ?_⟩ - all_goals solve_by_elim[Nat.le_antisymm] - -def add : SortOpsCost → SortOpsCost → SortOpsCost - | ⟨c₁, i₁⟩, ⟨c₂, i₂⟩ => ⟨c₁ + c₂, i₁ + i₂⟩ - -def nsmul : ℕ → SortOpsCost → SortOpsCost - | n, ⟨c, i⟩ => ⟨n • c, n • i⟩ - - -instance acsSortOpsCost : AddCommMonoid SortOpsCost where - add := add - add_assoc := by - intro a b c - simp only [HAdd.hAdd] - simp [add, Nat.add_assoc] - add_comm := by - intro a b - simp only [HAdd.hAdd] - simp [add, Nat.add_comm] - zero_add := by - intro ⟨c, i⟩ - simp only [HAdd.hAdd, Add.add, add] - simp - add_zero := by - intro ⟨c, i⟩ - simp only [HAdd.hAdd, add] - simp [Add.add] - - nsmul := nsmul - nsmul_zero := by - intro x - rw [nsmul, zero_nsmul, zero_nsmul] - rfl - - nsmul_succ := by - intro n x - rw [nsmul, succ_nsmul, succ_nsmul] - rfl - - -def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where - evalQuery q := - match q with - | .cmpLT x y => - if x < y then - true - else - false - | .insertHead l x => x :: l - cost q := - match q with - | .cmpLT _ _ => ⟨1,0⟩ - | .insertHead _ _ => ⟨0,1⟩ - -@[grind =] -lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : - (sortModel α).evalQuery (cmpLT x y) ↔ x < y := by - simp [sortModel] - -@[grind =] -lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : - (sortModel α).evalQuery (insertHead l x) = x :: l := by - simp [sortModel] - - -lemma SortModel_addComponents (m₁ m₂ m₃ : SortOpsCost) : - m₁ + m₂ = m₃ ↔ - m₁.compares + m₂.compares = m₃.compares ∧ - m₁.inserts + m₂.inserts = m₃.inserts := by - simp only [HAdd.hAdd] - aesop - -@[simp] -lemma SortModel_add_compares (m₁ m₂ : SortOpsCost) : - (Add.add m₁ m₂).compares = m₁.compares + m₂.compares := by - cases m₁; cases m₂; rfl - -@[simp] -lemma SortModel_add_inserts (m₁ m₂ : SortOpsCost) : - (Add.add m₁ m₂).inserts = m₁.inserts + m₂.inserts := by - cases m₁; cases m₂; rfl - -lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : - m₁ ≤ m₂ ↔ - m₁.compares ≤ m₂.compares ∧ - m₁.inserts ≤ m₂.inserts := by - simp only [LE.le] - - - def insertOrdNaive (x : α) (l : List α) [LinearOrder α] := match l with | [] => [x] diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 65a712fac..5518b187c 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -7,36 +7,15 @@ Authors: Tanner Duve module public import Cslib.AlgorithmsTheory.QueryModel -public import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert +public import Cslib.AlgorithmsTheory.Models.ListComparisonSort @[expose] public section namespace Cslib.Algorithms - open SortOps -def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where - evalQuery q := - match q with - | .cmpLT x y => - if x < y then - true - else - false - | .insertHead l x => x :: l - cost q := - match q with - | .cmpLT _ _ => 1 - | .insertHead _ _ => 1 - -@[simp] -lemma sortModelNat_eval_1 [LinearOrder α] (y x : α) : - y ≤ x → (sortModelNat α).evalQuery (cmpLT x y) = false := by - intro h - simp only [sortModelNat, Bool.if_false_right, Bool.and_true, decide_eq_false_iff_not, not_lt] - exact h /-- Merge two sorted lists using comparisons in the query monad. -/ def mergeNaive [LinearOrder α] (x y : List α) : List α := match x,y with @@ -56,7 +35,7 @@ lemma mergeNaive_length [LinearOrder α] (x y : List α) : /-- Merge two sorted lists using comparisons in the query monad. -/ -@[simp, grind] +@[simp] def merge (x y : List α) : Prog (SortOps α) (List α) := do match x,y with | [], ys => return ys diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean new file mode 100644 index 000000000..848879f89 --- /dev/null +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean @@ -0,0 +1,35 @@ +/- +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 + + +namespace Cslib + +namespace Algorithms + +open Prog + +inductive ListSearch (α : Type) : Type → Type where + | compare (a : List α) (val : α) : ListSearch α Bool + + +def ListSearch_Nat [DecidableEq α] : Model (ListSearch α) ℕ where + evalQuery q := + match q with + | .compare l x => l.head? = some x + cost q := + match q with + | .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..377f18a69 --- /dev/null +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2026 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 + +open Prog +/-- The Model for comparison sorting natural-number registers. +-/ +inductive SortOps (α : Type) : Type → Type where + | cmpLT (x : α) (y : α): SortOps α Bool + | insertHead (l : List α) (x : α) : SortOps α (List α) + +open SortOps + +section SortOpsCostModel + +@[ext, grind] +structure SortOpsCost where + compares : ℕ + inserts : ℕ + + +@[simp, grind] +instance zeroSortOps : Zero SortOpsCost := ⟨0,0⟩ + + +@[simp, grind] +instance partialOrderSortOps : PartialOrder SortOpsCost where + le | ⟨c₁, i₁⟩, ⟨c₂, i₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ + le_refl := by + intro c + simp only [le_refl, and_self] + le_trans a b c := by + simp only [and_imp] + intro ab_comps ab_inserts bc_comps bc_inserts + refine ⟨?_, ?_⟩ + all_goals solve_by_elim [Nat.le_trans] + le_antisymm := by + intro ⟨a_comps, a_inserts⟩ ⟨b_comps, b_inserts⟩ + simp only [SortOpsCost.mk.injEq, and_imp] + intro ab_comps ab_inserts ba_comps ba_inserts + refine ⟨?_, ?_⟩ + all_goals solve_by_elim[Nat.le_antisymm] + +def add : SortOpsCost → SortOpsCost → SortOpsCost + | ⟨c₁, i₁⟩, ⟨c₂, i₂⟩ => ⟨c₁ + c₂, i₁ + i₂⟩ + +def nsmul : ℕ → SortOpsCost → SortOpsCost + | n, ⟨c, i⟩ => ⟨n • c, n • i⟩ + + +instance acsSortOpsCost : AddCommMonoid SortOpsCost where + add := add + add_assoc := by + intro a b c + simp only [HAdd.hAdd] + simp [add, Nat.add_assoc] + add_comm := by + intro a b + simp only [HAdd.hAdd] + simp [add, Nat.add_comm] + zero_add := by + intro ⟨c, i⟩ + simp only [HAdd.hAdd, Add.add, add] + simp + add_zero := by + intro ⟨c, i⟩ + simp only [HAdd.hAdd, add] + simp [Add.add] + + nsmul := nsmul + nsmul_zero := by + intro x + rw [nsmul, zero_nsmul, zero_nsmul] + rfl + + nsmul_succ := by + intro n x + rw [nsmul, succ_nsmul, succ_nsmul] + rfl + + +def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where + evalQuery q := + match q with + | .cmpLT x y => + if x < y then + true + else + false + | .insertHead l x => x :: l + cost q := + match q with + | .cmpLT _ _ => ⟨1,0⟩ + | .insertHead _ _ => ⟨0,1⟩ + +@[grind =] +lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : + (sortModel α).evalQuery (cmpLT x y) ↔ x < y := by + simp [sortModel] + +@[grind =] +lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : + (sortModel α).evalQuery (insertHead l x) = x :: l := by + simp [sortModel] + + +lemma SortModel_addComponents (m₁ m₂ m₃ : SortOpsCost) : + m₁ + m₂ = m₃ ↔ + m₁.compares + m₂.compares = m₃.compares ∧ + m₁.inserts + m₂.inserts = m₃.inserts := by + simp only [HAdd.hAdd] + aesop + +@[simp] +lemma SortModel_add_compares (m₁ m₂ : SortOpsCost) : + (Add.add m₁ m₂).compares = m₁.compares + m₂.compares := by + cases m₁; cases m₂; rfl + +@[simp] +lemma SortModel_add_inserts (m₁ m₂ : SortOpsCost) : + (Add.add m₁ m₂).inserts = m₁.inserts + m₂.inserts := by + cases m₁; cases m₂; rfl + +lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : + m₁ ≤ m₂ ↔ + m₁.compares ≤ m₂.compares ∧ + m₁.inserts ≤ m₂.inserts := by + simp only [LE.le] + +end SortOpsCostModel + +section NatModel + +def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where + evalQuery q := + match q with + | .cmpLT x y => + if x < y then + true + else + false + | .insertHead l x => x :: l + cost q := + match q with + | .cmpLT _ _ => 1 + | .insertHead _ _ => 1 + +@[simp] +lemma sortModelNat_eval_1 [LinearOrder α] (y x : α) : + y ≤ x → (sortModelNat α).evalQuery (cmpLT x y) = false := by + intro h + simp only [sortModelNat, Bool.if_false_right, Bool.and_true, decide_eq_false_iff_not, not_lt] + exact h + +end NatModel + +end Algorithms + +end Cslib diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean index 20861d017..e89d61af4 100644 --- a/CslibTests/QueryModel/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -35,35 +35,6 @@ def RatArithQuery_NatCost : Model (Arith ℚ) ℕ where | .one => (1 : ℚ) cost _ := 1 -structure AddMulCosts where - addCount : ℕ - mulCount : ℕ - pure : ℕ - -instance : Zero (AddMulCosts) where - zero := ⟨0,0,0⟩ - -instance : PureCosts (AddMulCosts) where - pureCost := ⟨0,0,1⟩ - -instance : Add (AddMulCosts) where - add x y := - let ⟨x_addcount, x_mulcount, x_pure⟩ := x - let ⟨y_addcount, y_mulcount, y_pure⟩ := y - ⟨x_addcount + y_addcount, x_mulcount + y_mulcount, x_pure + y_pure⟩ - -def RatArithQuery_AddMulCost : Model (Arith ℚ) AddMulCosts where - evalQuery - | .add x y => x + y - | .mul x y => x * y - | .neg x => -x - | .zero => (0 : ℚ) - | .one => (1 : ℚ) - cost - | .add _ _ => ⟨1,0,0⟩ - | .mul _ _ => ⟨0,1,0⟩ - | _ => 0 - open Arith in def ex1 : Prog (Arith ℚ) ℚ := do let mut x : ℚ ← @zero ℚ @@ -73,12 +44,9 @@ def ex1 : Prog (Arith ℚ) ℚ := do add w z -#eval ex1.eval RatArithQuery_NatCost -#eval ex1.time RatArithQuery_NatCost -#eval ex1.time RatArithQuery_AddMulCost - +--#eval ex1.eval RatArithQuery_NatCost +--#eval ex1.time RatArithQuery_NatCost -section ArraySort /-- The array version of the sort operations -/ @@ -126,13 +94,10 @@ def simpleExample (v : Vector ℤ n) (i k : Fin n) let elem ← read c i push c elem -#eval (simpleExample #v[1,2,3,4,5] 5 2).eval VecSort_WorstCase -#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_WorstCase -#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_CmpSwap - -end ArraySort +--#eval (simpleExample #v[1,2,3,4,5] 5 2).eval VecSort_WorstCase +--#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_WorstCase +--#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_CmpSwap -section VectorLinearSearch inductive VecSearch (α : Type) : Type → Type where | compare (a : Vector α n) (i : ℕ) (val : α) : VecSearch α Bool @@ -146,26 +111,6 @@ def VecSearch_Nat [DecidableEq α] : Model (VecSearch α) ℕ where match q with | .compare _ _ _ => 1 -structure CmpCount where - cmp : ℕ - pure : ℕ - -instance : Add (CmpCount) where - add x y := ⟨x.1 + y.1, x.2 + y.2⟩ - -instance : Zero (CmpCount) where - zero := ⟨0,0⟩ - -instance : PureCosts (CmpCount) where - pureCost := ⟨0,1⟩ - -def VecSearch_Cmp [DecidableEq α] : Model (VecSearch α) CmpCount where - evalQuery q := - match q with - | .compare l i x => l[i]? == some x - cost q := - match q with - | .compare _ _ _ => ⟨1,0⟩ open VecSearch in def linearSearchAux (v : Vector α n) @@ -183,298 +128,10 @@ open VecSearch in def linearSearch (v : Vector α n) (x : α) : Prog (VecSearch α) Bool:= linearSearchAux v x false 0 -#eval (linearSearch #v[12,23,31,42,52,4,6] 4).eval VecSearch_Nat -#eval (linearSearch #v[1,2,3,4,5,6] 7).eval VecSearch_Cmp - -#eval (linearSearch #v[1,2,3,22, 11, 12, 4,5,6] 4).time VecSearch_Nat -#eval (linearSearch #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Cmp - - -lemma linearSearch_correct_true [DecidableEq α] (v : Vector α n) - (hn_pos : n > 0) : - ∀ x : α, x ∈ v → (linearSearch v x).eval VecSearch_Nat = true := by - intro x x_mem_v - simp only [linearSearch] - induction n with - | zero => - simp_all - | succ n ih => - simp_all only [gt_iff_lt, lt_add_iff_pos_left, add_pos_iff, zero_lt_one, or_true] - unfold linearSearchAux - split_ifs with h_cond - · simp_all - · simp [eval,liftBind] - unfold Prog.eval - simp_all only [ge_iff_le, nonpos_iff_eq_zero, Nat.add_eq_zero_iff, one_ne_zero, and_false, - not_false_eq_true, bind, FreeM.lift_def, pure, zero_add, FreeM.liftBind_bind, - FreeM.pure_bind] - -lemma linearSearch_correct_false [DecidableEq α] (v : Vector α n) : - ∀ x : α, x ∉ v → (linearSearch v x).eval VecSearch_Nat = false := by - intro x x_mem_v - simp only [linearSearch] - induction n with - | zero => - simp_all [VecSearch_Nat] - sorry - | succ n ih => - sorry - -lemma linearSearch_time_complexity [DecidableEq α] (v : Vector α n) : - ∀ x : α, (linearSearch v x).time VecSearch_Nat ≤ n + 1 := by - intro x - simp only [linearSearch, VecSearch_Nat] - induction n with - | zero => - simp_all [linearSearchAux, time, PureCosts.pureCost] - | succ n ih => - unfold linearSearchAux - split_ifs with h_cond - · simp_all - · simp [time] - sorry - --- The Monadic version -open VecSearch in -def linearSearchM (v : Vector α n) (x : α) : Prog (VecSearch α) Bool := do - let mut comp_res : Bool := false - for i in [0:n] do - comp_res ← compare v i x - if comp_res == true then - break - else - continue - return comp_res - -#eval (linearSearchM #v[12,23,31,42,52,4,6] 4).eval VecSearch_Nat -#eval (linearSearchM #v[1,2,3,4,5,6] 7).eval VecSearch_Nat - -#eval (linearSearchM #v[1,2,3,22, 11, 12, 4,5,6] 4).time VecSearch_Nat -#eval (linearSearchM #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Nat -#eval (linearSearchM #v[1,2,3,22, 11, 12, 4,5,6] 7).time VecSearch_Cmp - -lemma linearSearchM_correct_true [DecidableEq α] (v : Vector α n) : - ∀ x : α, x ∈ v → (linearSearchM v x).eval VecSearch_Nat = true := by - intro x x_mem_v - induction h : v.toArray.toList with - | nil => - simp_all [linearSearchM, eval] - have v_empty : h ▸ v = #v[] := by - simp - have x_not_mem_v : x ∉ v := by - subst h - aesop - tauto - | cons head tail ih => - sorry - - -lemma linearSearchM_correct_false [DecidableEq α] (v : Vector α n) : - ∀ x : α, x ∉ v → (linearSearchM v x).eval VecSearch_Nat = false := by - intro x x_mem_v - induction h : v.toArray.toList with - | nil => - simp_all [linearSearchM, eval] - | cons head tail ih => - simp_all [linearSearchM] - sorry - -lemma linearSearchM_time_complexity [DecidableEq α] (v : Vector α n) : - ∀ x : α, (linearSearchM v x).time VecSearch_Nat ≤ n + 1 := by - intro x - induction h : v.toArray.toList with - | nil => - simp_all [linearSearchM, time, PureCosts.pureCost] - | cons head tail ih => - simp_all [linearSearchM, VecSearch_Nat] - sorry - - -end VectorLinearSearch - -section ListLinearSearch -inductive ListSearch (α : Type) : Type → Type where - | compare (a : List α) (val : α) : ListSearch α Bool - - -def ListSearch_Nat [DecidableEq α] : Model (ListSearch α) ℕ where - evalQuery q := - match q with - | .compare l x => l.head? = some x - cost q := - match q with - | .compare _ _ => 1 - - -def ListSearch_Cmp [DecidableEq α] : Model (ListSearch α) CmpCount where - evalQuery q := - match q with - | .compare l x => l.head? == some x - cost q := - match q with - | .compare _ _ => ⟨1,0⟩ - -open ListSearch in -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 - -lemma listLinearSearchM_correct_true [iDec : DecidableEq α] (l : List α) : - ∀ x : α, x ∈ l → (listLinearSearch l x).eval ListSearch_Nat = true := by - intro x x_mem_l - induction l with - | nil => - simp_all only [List.not_mem_nil] - | cons head tail ih => - simp_all only [List.mem_cons, listLinearSearch, bind, FreeM.lift_def, pure, - FreeM.liftBind_bind, FreeM.pure_bind, eval] - split_ifs with h - · simp [eval] - · obtain (x_head | xtail) := x_mem_l - · rw [x_head] at h - simp[ListSearch_Nat] at h - · specialize ih xtail - exact ih - -lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) : - ∀ x : α, x ∉ l → (listLinearSearch l x).eval ListSearch_Nat = false := by - intro x x_mem_l - induction l with - | nil => - simp_all [listLinearSearch, eval] - | cons head tail ih => - simp only [List.mem_cons, not_or] at x_mem_l - specialize ih x_mem_l.2 - simp only [listLinearSearch, bind, FreeM.lift_def, pure, FreeM.liftBind_bind, FreeM.pure_bind, - eval] - split_ifs with h_eq - · simp [ListSearch_Nat] at h_eq - exfalso - exact x_mem_l.1 h_eq.symm - · exact ih - - - -lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List α) : - ∀ x : α, (listLinearSearch l x).time ListSearch_Nat ≤ 1 + l.length := by - intro x - induction l with - | nil => - simp_all [listLinearSearch, ListSearch_Nat, time, PureCosts.pureCost] - | cons head tail ih => - simp_all [listLinearSearch, ListSearch_Nat, time] - split_ifs with h_head - · simp [time, PureCosts.pureCost] - · grind - -lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Nontrivial α] : - ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = 1 + l.length := by - obtain ⟨x, y, x_neq_y⟩ := inon - use [x,x,x,x,x,y], y - simp_all [time, ListSearch_Nat, listLinearSearch, PureCosts.pureCost] - - -end ListLinearSearch - - -section ListBinarySearch -inductive ListBinSearch (α : Type) : Type → Type where - | compare (a : List α) (i : Fin a.length) (val : α) : ListBinSearch α Ordering - - -def ListBinSearch_Nat [LinearOrder α] : Model (ListBinSearch α) ℕ where - evalQuery q := - match q with - | .compare l i x => - if l[i]? = some x - then Ordering.eq - else - if l[i]? < some x - then Ordering.lt - else - Ordering.gt - cost q := - match q with - | .compare _ _ _ => 1 - +--#eval (linearSearch #v[12,23,31,42,52,4,6] 4).eval VecSearch_Nat -def ListBinSearch_Cmp [DecidableEq α] : Model (ListBinSearch α) CmpCount where - evalQuery q := - match q with - | .compare l i x => l[i]? == some x - cost q := - match q with - | .compare _ _ _ => ⟨1,0⟩ +--#eval (linearSearch #v[1,2,3,22, 11, 12, 4,5,6] 4).time VecSearch_Nat -open ListSearch in -def listBinarySearchAux (l : List α) (x : α) (lo hi : Fin l.length) : Prog (ListBinSearch α) Bool := do - let mid : Fin l.length := (lo + hi) / 2 - if compare l mid x then - return true - else - if comp -lemma listBinarySearchM_correct_true [iDec : DecidableEq α] (l : List α) : - ∀ x : α, x ∈ l → (listLinearSearch l x).eval ListSearch_Nat = true := by - intro x x_mem_l - induction l with - | nil => - simp_all only [List.not_mem_nil] - | cons head tail ih => - simp_all only [List.mem_cons, listLinearSearch, bind, FreeM.lift_def, pure, - FreeM.liftBind_bind, FreeM.pure_bind, eval] - split_ifs with h - · simp [eval] - · obtain (x_head | xtail) := x_mem_l - · rw [x_head] at h - simp[ListSearch_Nat] at h - · specialize ih xtail - exact ih - -lemma listBinarySearchM_correct_false [DecidableEq α] (l : List α) : - ∀ x : α, x ∉ l → (listLinearSearch l x).eval ListSearch_Nat = false := by - intro x x_mem_l - induction l with - | nil => - simp_all [listLinearSearch, eval] - | cons head tail ih => - simp only [List.mem_cons, not_or] at x_mem_l - specialize ih x_mem_l.2 - simp only [listLinearSearch, bind, FreeM.lift_def, pure, FreeM.liftBind_bind, FreeM.pure_bind, - eval] - split_ifs with h_eq - · simp [ListSearch_Nat] at h_eq - exfalso - exact x_mem_l.1 h_eq.symm - · exact ih - - - -lemma listBinarySearchM_time_complexity_upper_bound [DecidableEq α] (l : List α) : - ∀ x : α, (listLinearSearch l x).time ListSearch_Nat ≤ 1 + l.length := by - intro x - induction l with - | nil => - simp_all [listLinearSearch, ListSearch_Nat, time, PureCosts.pureCost] - | cons head tail ih => - simp_all [listLinearSearch, ListSearch_Nat, time] - split_ifs with h_head - · simp [time, PureCosts.pureCost] - · grind - -lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Nontrivial α] : - ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = 1 + l.length := by - obtain ⟨x, y, x_neq_y⟩ := inon - use [x,x,x,x,x,y], y - simp_all [time, ListSearch_Nat, listLinearSearch, PureCosts.pureCost] - - -end ListBinarySearch end ProgExamples From 15986853a60ebf18ba9b552f5e11531b6ee4e13b Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 07:14:03 +0100 Subject: [PATCH 084/176] Lint passes locally --- .../Algorithms/ListInsertionSort.lean | 3 ++ .../Algorithms/ListLinearSearch.lean | 4 +++ .../Algorithms/ListOrderedInsert.lean | 8 +++++ .../Algorithms/MergeSort.lean | 7 ++++ .../Models/ListComparisonSearch.lean | 8 +++++ .../Models/ListComparisonSort.lean | 22 ++++++++++-- Cslib/AlgorithmsTheory/QueryModel.lean | 34 +++++++++++++++++-- 7 files changed, 80 insertions(+), 6 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index 5e6f30f39..289ecc141 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -17,6 +17,9 @@ namespace Algorithms open Prog +/-- +The insertionSort algorithms on lists with the `SortOps` query +-/ def insertionSort (l : List α) : Prog (SortOps α) (List α) := match l with | [] => return [] diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index 49d73d0ca..109a990af 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -19,7 +19,11 @@ 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 diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 5a99e45b9..c959a6e35 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -19,6 +19,10 @@ open Prog open SortOps +/-- +A purely lean version of `insertOrd`, which is shown to be extensionally equal to +`insertOrd` when evaluated in the `SortOps` query model. +-/ def insertOrdNaive (x : α) (l : List α) [LinearOrder α] := match l with | [] => [x] @@ -72,6 +76,10 @@ lemma insertOrdNaive_sorted [LinearOrder α] (x : α) (l : List α) : · simp only [List.pairwise_cons, List.mem_cons, forall_eq_or_imp, h₂, and_true] grind +/-- +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 l x diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 5518b187c..c068061b2 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -115,6 +115,10 @@ lemma merge_length [LinearOrder α] (x y : List α) : rw [merge_is_mergeNaive] apply mergeNaive_length +/-- +The `mergeSort` algorithm in the `SortOps` query model. It sorts the input list +according to the mergeSort algorithm. +-/ def mergeSort (xs : List α) : Prog (SortOps α) (List α) := do if xs.length < 2 then return xs else @@ -125,6 +129,9 @@ def mergeSort (xs : List α) : Prog (SortOps α) (List α) := do let sortedRight ← mergeSort right merge sortedLeft sortedRight +/-- +The vanilla-lean version of `mergeSortNaive` that is extensionally equal to `mergeSort` +-/ def mergeSortNaive [LinearOrder α] (xs : List α) : List α := if xs.length < 2 then xs else diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean index 848879f89..a9f8ef992 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean @@ -18,10 +18,18 @@ 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 costs to the queries in `ℕ` +-/ def ListSearch_Nat [DecidableEq α] : Model (ListSearch α) ℕ where evalQuery q := match q with diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 377f18a69..21ae518c6 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -15,26 +15,34 @@ namespace Cslib namespace Algorithms open Prog -/-- The Model for comparison sorting natural-number registers. +/-- +A model for comparison sorting on lists. -/ inductive SortOps (α : Type) : Type → Type where + /--`cmpLt 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-/ | cmpLT (x : α) (y : α): SortOps α Bool + /--`insertHead l x` is intended to return `x :: l`-/ | insertHead (l : List α) (x : α) : 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 : ℕ - @[simp, grind] instance zeroSortOps : Zero SortOpsCost := ⟨0,0⟩ - @[simp, grind] instance partialOrderSortOps : PartialOrder SortOpsCost where le | ⟨c₁, i₁⟩, ⟨c₂, i₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ @@ -53,9 +61,11 @@ instance partialOrderSortOps : PartialOrder SortOpsCost where refine ⟨?_, ?_⟩ all_goals solve_by_elim[Nat.le_antisymm] +/-- Component-wise addition operation on `SortOpsCost` -/ def add : SortOpsCost → SortOpsCost → SortOpsCost | ⟨c₁, i₁⟩, ⟨c₂, i₂⟩ => ⟨c₁ + c₂, i₁ + i₂⟩ +/-- Component-wise scalar (natural number) multiplication operation on `SortOpsCost` -/ def nsmul : ℕ → SortOpsCost → SortOpsCost | n, ⟨c, i⟩ => ⟨n • c, n • i⟩ @@ -91,6 +101,9 @@ instance acsSortOpsCost : AddCommMonoid SortOpsCost where rfl +/-- +A model of `SortOps` that uses `SortOpsCost` as the cost type for operations. +-/ def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where evalQuery q := match q with @@ -143,6 +156,9 @@ end SortOpsCostModel section NatModel +/-- +A model of `SortOps` that uses `ℕ` as the type for the cost of operations. +-/ def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where evalQuery q := match q with diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 0af0ea2df..f3aea3b30 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -47,21 +47,40 @@ query model, free monad, time complexity, Prog namespace Cslib.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 u) (Cost : Type) [AddCommMonoid Cost] 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 +/-- +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 α instance {Q α} : Coe (Q α) (FreeM Q α) where coe := FreeM.lift +/-- +The evaluation function of a program `P : Prog Q α` given a model `M : Model Q α` of `Q` +-/ @[simp, grind] def Prog.eval [AddCommMonoid Cost] (P : Prog Q α) (M : Model Q Cost) : α := Id.run <| P.liftM fun x => pure (M.evalQuery x) +/-- +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. +-/ @[simp, grind] def Prog.time [AddCommMonoid Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := @@ -72,18 +91,18 @@ def Prog.time [AddCommMonoid Cost] let qval := M.evalQuery op t₁ + (time (cont qval) M) -@[simp, grind =] +@[grind =] lemma Prog.time.bind_pure [AddCommMonoid Cost] (M : Model Q Cost) : Prog.time (op >>= FreeM.pure) M = (Prog.time op M) := by simp only [bind, FreeM.bind_pure] -@[simp, grind =] +@[grind =] lemma Prog.time.pure_bind [AddCommMonoid Cost] (M : Model Q Cost) : Prog.time (FreeM.pure x >>= m) M = (m x).time M := by rfl -@[simp, grind =] +@[grind =] lemma Prog.time.bind [AddCommMonoid Cost] (M : Model Q Cost) (op : Prog Q ι) (cont : ι → Prog Q α) : Prog.time (op >>= cont) M = @@ -106,9 +125,18 @@ lemma Prog.time.liftBind [AddCommMonoid Cost] (M : Model Q Cost) 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₁` +-/ def Prog.reduceProg (P : Prog Q₁ α) (red : Reduction Q₁ Q₂) : Prog Q₂ α := P.liftM red.reduce From cc27876d6e8f1bd71a85c7fe1577b4613c3855fb Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 07:19:42 +0100 Subject: [PATCH 085/176] Ran lake exe mk_all --module --- Cslib.lean | 2 +- CslibTests.lean | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/Cslib.lean b/Cslib.lean index 45dbf4b15..be342da0d 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,8 +1,8 @@ module -- shake: keep-all -public import Cslib.AlgorithmsTheory.Algorithms.ListOrderedInsert 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 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 From 1b44e04a0b0d5dd008d095f581dc3cf74fbec7dc Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 14:27:21 +0100 Subject: [PATCH 086/176] Remove Dead Code --- .../Models/ListComparisonSearch.lean | 6 ++---- .../Models/ListComparisonSort.lean | 6 ++---- CslibTests/QueryModel/ProgExamples.lean | 19 ------------------- CslibTests/QueryModel/QueryExamples.lean | 9 ++++++--- 4 files changed, 10 insertions(+), 30 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean index a9f8ef992..44f2d41e5 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean @@ -31,11 +31,9 @@ inductive ListSearch (α : Type) : Type → Type where A model of the `ListSearch` query type that assigns costs to the queries in `ℕ` -/ def ListSearch_Nat [DecidableEq α] : Model (ListSearch α) ℕ where - evalQuery q := - match q with + evalQuery | .compare l x => l.head? = some x - cost q := - match q with + cost | .compare _ _ => 1 end Algorithms diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 21ae518c6..27563042f 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -160,16 +160,14 @@ section NatModel A model of `SortOps` that uses `ℕ` as the type for the cost of operations. -/ def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where - evalQuery q := - match q with + evalQuery | .cmpLT x y => if x < y then true else false | .insertHead l x => x :: l - cost q := - match q with + cost | .cmpLT _ _ => 1 | .insertHead _ _ => 1 diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean index e89d61af4..57bc16179 100644 --- a/CslibTests/QueryModel/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -43,10 +43,6 @@ def ex1 : Prog (Arith ℚ) ℚ := do let w ← @neg ℚ (←(add z y)) add w z - ---#eval ex1.eval RatArithQuery_NatCost ---#eval ex1.time RatArithQuery_NatCost - /-- The array version of the sort operations -/ @@ -64,7 +60,6 @@ def VecSort_WorstCase [DecidableEq α] : Model (VecSortOps α) ℕ where | .read l i => l[i] | .swap l i j => l.swap i j | .push a elem => a.push elem - cost | .write l i x => 1 | .read l i => 1 @@ -79,13 +74,11 @@ def VecSort_CmpSwap [DecidableEq α] : Model (VecSortOps α) ℕ where | .read l i => l[i] | .swap l i j => l.swap i j | .push a elem => a.push elem - cost | .cmp l i j => 1 | .swap l i j => 1 | _ => 0 - open VecSortOps in def simpleExample (v : Vector ℤ n) (i k : Fin n) : Prog (VecSortOps ℤ) (Vector ℤ (n + 1)) := do @@ -94,15 +87,9 @@ def simpleExample (v : Vector ℤ n) (i k : Fin n) let elem ← read c i push c elem ---#eval (simpleExample #v[1,2,3,4,5] 5 2).eval VecSort_WorstCase ---#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_WorstCase ---#eval (simpleExample #v[1,2,3,4,5] 5 2).time VecSort_CmpSwap - - inductive VecSearch (α : Type) : Type → Type where | compare (a : Vector α n) (i : ℕ) (val : α) : VecSearch α Bool - def VecSearch_Nat [DecidableEq α] : Model (VecSearch α) ℕ where evalQuery q := match q with @@ -111,7 +98,6 @@ def VecSearch_Nat [DecidableEq α] : Model (VecSearch α) ℕ where match q with | .compare _ _ _ => 1 - open VecSearch in def linearSearchAux (v : Vector α n) (x : α) (acc : Bool) (index : ℕ) : Prog (VecSearch α) Bool := do @@ -128,11 +114,6 @@ open VecSearch in def linearSearch (v : Vector α n) (x : α) : Prog (VecSearch α) Bool:= linearSearchAux v x false 0 ---#eval (linearSearch #v[12,23,31,42,52,4,6] 4).eval VecSearch_Nat - ---#eval (linearSearch #v[1,2,3,22, 11, 12, 4,5,6] 4).time VecSearch_Nat - - end ProgExamples end Prog diff --git a/CslibTests/QueryModel/QueryExamples.lean b/CslibTests/QueryModel/QueryExamples.lean index 5360c130f..19bfcb987 100644 --- a/CslibTests/QueryModel/QueryExamples.lean +++ b/CslibTests/QueryModel/QueryExamples.lean @@ -17,12 +17,17 @@ 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) : Type → Type where | get (l : List α) (i : Fin l.length) : ListOps α α | find (l : List α) (elem : α) : ListOps α ℕ | write (l : List α) (i : Fin l.length) (x : α) : ListOps α (List α) - def List_LinSearch_WorstCase [DecidableEq α] : Model (ListOps α) ℕ where evalQuery | .write l i x => l.set i x @@ -33,8 +38,6 @@ def List_LinSearch_WorstCase [DecidableEq α] : Model (ListOps α) ℕ where | .find l elem => l.length | .get l i => l.length - - def List_BinSearch_WorstCase [BEq α] : Model (ListOps α) ℕ where evalQuery | .write l i x => l.set i x From 9a3b3e04e3ac38c8ea398ac5e8423e0ae8e1532c Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 14:28:27 +0100 Subject: [PATCH 087/176] Fix docstring of mergeNaive --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index c068061b2..a9508796b 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -16,7 +16,10 @@ namespace Cslib.Algorithms open SortOps -/-- Merge two sorted lists using comparisons in the query monad. -/ +/-- +The vanilla-lean version of `merge` that merges two lists. When the two lists +are sorted, so is the merged list. +-/ def mergeNaive [LinearOrder α] (x y : List α) : List α := match x,y with | [], ys => ys From af3a8d175650212ca5d525e977c37cacf47fedb1 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 14:32:36 +0100 Subject: [PATCH 088/176] Use the ML definition-by-match-expression formal for defining evalQuery and cost everywhere --- CslibTests/QueryModel/ProgExamples.lean | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean index 57bc16179..4c95a00cc 100644 --- a/CslibTests/QueryModel/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -26,8 +26,7 @@ inductive Arith (α : Type) : Type → Type where | one : Arith α α def RatArithQuery_NatCost : Model (Arith ℚ) ℕ where - evalQuery q := - match q with + evalQuery | .add x y => x + y | .mul x y => x * y | .neg x => -x @@ -91,11 +90,9 @@ inductive VecSearch (α : Type) : Type → Type where | compare (a : Vector α n) (i : ℕ) (val : α) : VecSearch α Bool def VecSearch_Nat [DecidableEq α] : Model (VecSearch α) ℕ where - evalQuery q := - match q with + evalQuery | .compare l i x => l[i]? == some x - cost q := - match q with + cost | .compare _ _ _ => 1 open VecSearch in From 85bf956a5c3efc1f4a7ea57156e3181031f661f3 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 14:41:03 +0100 Subject: [PATCH 089/176] Fix Indent in Prog --- CslibTests/QueryModel/ProgExamples.lean | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean index 4c95a00cc..fd5dbe149 100644 --- a/CslibTests/QueryModel/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -98,14 +98,14 @@ def VecSearch_Nat [DecidableEq α] : Model (VecSearch α) ℕ where 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 + if h : index ≥ n then + return acc else - linearSearchAux v x false (index + 1) + 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:= From a1731e6b0614e1b4be38dda04ed37cc4c267546f Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 14:44:46 +0100 Subject: [PATCH 090/176] Fix line breaks --- Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index 109a990af..cf46c1893 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -55,6 +55,7 @@ lemma listLinearSearchM_correct_true [iDec : DecidableEq α] (l : List α) : simp [ListSearch_Nat, List.head?_cons, decide_true] at h · specialize ih x_tail simp_all + lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) : ∀ x : α, x ∉ l → (listLinearSearch l x).eval ListSearch_Nat = false := by intro x x_mem_l @@ -72,8 +73,6 @@ lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) : exact x_mem_l.1 h_eq.symm · exact ih - - lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List α) : ∀ x : α, (listLinearSearch l x).time ListSearch_Nat ≤ 1 + l.length := by intro x @@ -92,6 +91,6 @@ lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Non use [x,x,x,x,x,y], y simp_all [ListSearch_Nat, listLinearSearch] - end Algorithms + end Cslib From 7293c639d0bd0fd53ff25cc6608e90ad52c8e145 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 14:47:23 +0100 Subject: [PATCH 091/176] Fix line breaks --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index a9508796b..12237730c 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -472,4 +472,5 @@ theorem mergeSort_complexity [LinearOrder α] (xs : List α) : end TimeComplexity + end Cslib.Algorithms From 8c1a33a7581050f7494a8711f47cfc4baca6276b Mon Sep 17 00:00:00 2001 From: Shreyas Date: Fri, 20 Feb 2026 14:47:34 +0100 Subject: [PATCH 092/176] Fix line breaks --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 1 - 1 file changed, 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 12237730c..0ba2ab484 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -470,7 +470,6 @@ theorem mergeSort_complexity [LinearOrder α] (xs : List α) : simpa [T, hsub1, hsub2, hsub3, hsplit, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using hs - end TimeComplexity end Cslib.Algorithms From a32bb22348890b5fb7c18eabd32cadac44ff425d Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 21 Feb 2026 03:10:16 +0100 Subject: [PATCH 093/176] OrderedInsert fixed --- .../Algorithms/ListOrderedInsert.lean | 166 +++++++----------- .../Models/ListComparisonSort.lean | 30 ++-- 2 files changed, 79 insertions(+), 117 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index c959a6e35..8b12f7534 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -19,112 +19,70 @@ open Prog open SortOps -/-- -A purely lean version of `insertOrd`, which is shown to be extensionally equal to -`insertOrd` when evaluated in the `SortOps` query model. --/ -def insertOrdNaive (x : α) (l : List α) [LinearOrder α] := - match l with - | [] => [x] - | a :: as => if a < x then a :: insertOrdNaive x as else x :: (a :: as) - -lemma insertOrdNaive_mem [LinearOrder α] - (x y : α) (l : List α) (hx : x ∈ insertOrdNaive y l) : x = y ∨ x ∈ l := by - induction l with - | nil => - simp only [insertOrdNaive, List.mem_cons, List.not_mem_nil, or_false] at hx - left - exact hx - | cons head tail ih => - simp_all only [insertOrdNaive, List.mem_cons] - split_ifs at hx with h_head - · simp only [List.mem_cons] at hx - obtain (hx | hx) := hx - · tauto - · specialize ih hx - tauto - · simp at hx - assumption - -lemma insertOrdNaive_length [LinearOrder α] (x : α) (l : List α) : - (insertOrdNaive x l).length = l.length + 1 := by - induction l with - | nil => - simp [insertOrdNaive] - | cons head tail ih => - by_cases h : head < x <;> simp [insertOrdNaive, h, ih] - -lemma insertOrdNaive_sorted [LinearOrder α] (x : α) (l : List α) : - l.Pairwise (· ≤ ·) → (insertOrdNaive x l).Pairwise (· ≤ ·) := by - intro h - induction l with - | nil => - cases h with - | nil => simp [insertOrdNaive] - | cons head tail ih => - cases h with - | cons h₁ h₂ => - specialize ih h₂ - simp only [insertOrdNaive] - split_ifs with h_head - · simp only [List.pairwise_cons, ih, and_true] - intro a ha - apply insertOrdNaive_mem at ha - obtain (ha | ha) := ha - · grind - · grind - · simp only [List.pairwise_cons, List.mem_cons, forall_eq_or_imp, h₂, and_true] - grind - /-- 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 l x + | [] => insertHead x l | a :: as => - let cmp : Bool ← cmpLT a x + let cmp : Bool ← cmpLE x a if cmp then - let res ← insertOrd x as - insertHead res a + insertHead x (a :: as) else - insertHead (a :: as) x + let res ← insertOrd x as + insertHead a res -lemma insertOrd_is_insertOrdNaive [LinearOrder α] : +lemma insertOrd_is_ListOrderedInsert [LinearOrder α] : ∀ (x : α) (l : List α) , - (insertOrd x l).eval (sortModel α) = insertOrdNaive x l := by - intro x l + l.Pairwise (· ≤ ·) → + (insertOrd x l).eval (sortModel α) = l.orderedInsert (· ≤ ·) x := by + intro x l h_sorted induction l with | nil => - simp_all [insertOrd, insertOrdNaive, sortModel] + simp [insertOrd, sortModel] | cons head tail ih => - simp_all only [eval, sortModel, Bool.if_false_right, Bool.and_true, insertOrd, bind, - FreeM.lift_def, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, insertOrdNaive] - split_ifs with h_head - · simp only [FreeM.liftM_bind, FreeM.liftM_liftBind, FreeM.liftM_pure, bind_pure, - bind_pure_comp, Id.run_map, List.cons.injEq, true_and] - exact ih - · simp_all only [decide_false, reduceCtorEq] - · simp_all - · simp_all + rcases List.pairwise_cons.1 h_sorted with ⟨h_head_tail, h_tail_sorted⟩ + by_cases h_head : head ≤ x + · by_cases h_x : x ≤ head + · have hx_head : head = x := le_antisymm h_head h_x + have htail : tail.orderedInsert (· ≤ ·) x = x :: tail := by + cases tail with + | nil => + simp + | cons y ys => + have hy : x ≤ y := by simpa [hx_head] using h_head_tail y (by simp) + simpa using List.orderedInsert_cons_of_le (· ≤ ·) ys hy + simp [insertOrd, sortModel, List.orderedInsert_cons, hx_head] + · simpa [insertOrd, sortModel, List.orderedInsert_cons, h_head, h_x] using ih h_tail_sorted + · have h_x : x ≤ head := le_of_not_ge h_head + simp [insertOrd, sortModel, List.orderedInsert_cons, h_x] + + lemma insertOrd_length [LinearOrder α] (x : α) (l : List α) : ((insertOrd x l).eval (sortModel α)).length = l.length + 1 := by - rw [insertOrd_is_insertOrdNaive] - simp [insertOrdNaive_length] + induction l with + | nil => + simp [insertOrd, sortModel] + | cons head tail ih => + by_cases h_head : x <= head + · simp [insertOrd, sortModel, h_head] + · simp [insertOrd, sortModel, h_head] + simpa [Prog.eval] using ih lemma bind_compares {α} (x tail head) [LinearOrder α] : (Prog.time (FreeM.bind (insertOrd x tail) - (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + (fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) (sortModel α)).compares = (Prog.time (insertOrd x tail) (sortModel α)).compares := by have h := congrArg SortOpsCost.compares (Prog.time.bind (M := sortModel α) (op := insertOrd x tail) - (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + (cont := fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) simp only [FreeM.bind_eq_bind, sortModel, Bool.if_false_right, Bool.and_true, HAdd.hAdd, time, eval, SortModel_add_compares] at h simp only [Add.add] at h @@ -135,25 +93,25 @@ lemma bind_compares {α} (x tail head) [LinearOrder α] : lemma bind_inserts {α} (x tail head) [LinearOrder α] : (Prog.time (FreeM.bind (insertOrd x tail) - (fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + (fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) (sortModel α)).inserts = (Prog.time (insertOrd x tail) (sortModel α)).inserts + 1 := by have h := congrArg SortOpsCost.inserts (Prog.time.bind (M := sortModel α) (op := insertOrd x tail) - (cont := fun res => FreeM.liftBind (insertHead res head) FreeM.pure)) + (cont := fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) simp only [HAdd.hAdd, bind, sortModel, Bool.if_false_right, Bool.and_true, SortModel_add_inserts, time, eval] at h simp only [Add.add] at h exact h @[simp] -lemma cost_cmpLT_compares [LinearOrder α] : ((sortModel α).2 (cmpLT head x)).compares = 1 := by +lemma cost_cmpLT_compares [LinearOrder α] : ((sortModel α).2 (cmpLE head x)).compares = 1 := by simp [sortModel] @[simp] lemma cost_cmpLT_inserts [LinearOrder α] - : ((sortModel α).2 (cmpLT head x)).inserts = 0 := by + : ((sortModel α).2 (cmpLE head x)).inserts = 0 := by simp [sortModel] @[simp] @@ -174,32 +132,36 @@ theorem insertOrd_complexity_upper_bound [LinearOrder α] : | nil => simp [insertOrd, sortModel] | cons head tail ih => - simp_all only [insertOrd, FreeM.lift_def, FreeM.bind_eq_bind, FreeM.liftBind_bind, - FreeM.pure_bind, time.eq_2, List.length_cons] obtain ⟨ih_compares, ih_inserts⟩ := ih - split_ifs with h_head - · simp only [HAdd.hAdd, Add.add, add, Nat.add] - simp only [Nat.add_eq, Nat.succ_eq_add_one] - constructor - · clear ih_inserts - rw [bind_compares, cost_cmpLT_compares] - grind - · clear ih_compares - rw [cost_cmpLT_inserts, bind_inserts] - grind - · simp only [HAdd.hAdd, sortModel, Bool.if_false_right, Bool.and_true, time] - simp only [Add.add, add, add_zero, zero_add, Nat.add_eq] - refine ⟨?_, ?_⟩ - · grind - · grind + by_cases h_head : x ≤ head + · constructor <;> simp [sortModel, h_head] + · constructor + · simp only [sortModel, Bool.if_false_right, Bool.and_true, h_head, decide_false, + FreeM.lift_def, FreeM.bind_eq_bind, FreeM.pure_bind, Bool.false_eq_true, ↓reduceIte, + List.length_cons] + change 1 + (Prog.time + (FreeM.bind (insertOrd x tail) + (fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) + (sortModel α)).compares ≤ tail.length + 1 + rw [bind_compares] + nlinarith [ih_compares] + · simp only [sortModel, Bool.if_false_right, Bool.and_true, h_head, decide_false, + FreeM.lift_def, FreeM.bind_eq_bind, FreeM.pure_bind, Bool.false_eq_true, ↓reduceIte, + zero_add, List.length_cons] + change (Prog.time + (FreeM.bind (insertOrd x tail) + (fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) + (sortModel α)).inserts ≤ tail.length + 1 + 1 + rw [bind_inserts] + nlinarith [ih_inserts] lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : l.Pairwise (· ≤ ·) → ((insertOrd x l).eval (sortModel α)).Pairwise (· ≤ ·) := by intro l_mono - rw [insertOrd_is_insertOrdNaive x l] - apply insertOrdNaive_sorted + rw [insertOrd_is_ListOrderedInsert x l l_mono] + apply List.Pairwise.orderedInsert assumption end Algorithms diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 27563042f..5c0a2f9f2 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -19,11 +19,11 @@ open Prog A model for comparison sorting on lists. -/ inductive SortOps (α : Type) : Type → Type where - /--`cmpLt x y` is intended to return `true` if `x < y` and `false` otherwise. + /--`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-/ - | cmpLT (x : α) (y : α): SortOps α Bool + | cmpLE (x : α) (y : α): SortOps α Bool /--`insertHead l x` is intended to return `x :: l`-/ - | insertHead (l : List α) (x : α) : SortOps α (List α) + | insertHead (x : α) (l : List α) : SortOps α (List α) open SortOps @@ -107,25 +107,25 @@ A model of `SortOps` that uses `SortOpsCost` as the cost type for operations. def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where evalQuery q := match q with - | .cmpLT x y => - if x < y then + | .cmpLE x y => + if x ≤ y then true else false - | .insertHead l x => x :: l + | .insertHead x l => x :: l cost q := match q with - | .cmpLT _ _ => ⟨1,0⟩ + | .cmpLE _ _ => ⟨1,0⟩ | .insertHead _ _ => ⟨0,1⟩ @[grind =] lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : - (sortModel α).evalQuery (cmpLT x y) ↔ x < y := by + (sortModel α).evalQuery (cmpLE x y) ↔ x ≤ y := by simp [sortModel] @[grind =] lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : - (sortModel α).evalQuery (insertHead l x) = x :: l := by + (sortModel α).evalQuery (insertHead x l) = x :: l := by simp [sortModel] @@ -161,21 +161,21 @@ A model of `SortOps` that uses `ℕ` as the type for the cost of operations. -/ def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where evalQuery - | .cmpLT x y => - if x < y then + | .cmpLE x y => + if x ≤ y then true else false - | .insertHead l x => x :: l + | .insertHead x l => x :: l cost - | .cmpLT _ _ => 1 + | .cmpLE _ _ => 1 | .insertHead _ _ => 1 @[simp] lemma sortModelNat_eval_1 [LinearOrder α] (y x : α) : - y ≤ x → (sortModelNat α).evalQuery (cmpLT x y) = false := by + y < x → (sortModelNat α).evalQuery (cmpLE x y) = false := by intro h - simp only [sortModelNat, Bool.if_false_right, Bool.and_true, decide_eq_false_iff_not, not_lt] + simp only [sortModelNat, Bool.if_false_right, Bool.and_true, decide_eq_false_iff_not, not_le] exact h end NatModel From 9cecfae59c22d92e4758c9a707ee741de9ecd947 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 21 Feb 2026 03:13:50 +0100 Subject: [PATCH 094/176] All ready --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 0ba2ab484..464abdee6 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -25,7 +25,7 @@ def mergeNaive [LinearOrder α] (x y : List α) : List α := | [], ys => ys | xs, [] => xs | x :: xs', y :: ys' => - if x < y then + if x ≤ y then let rest := mergeNaive xs' (y :: ys') x :: rest else @@ -44,7 +44,7 @@ def merge (x y : List α) : Prog (SortOps α) (List α) := do | [], ys => return ys | xs, [] => return xs | x :: xs', y :: ys' => do - let cmp : Bool ← cmpLT x y + let cmp : Bool ← cmpLE x y if cmp then let rest ← merge xs' (y :: ys') return (x :: rest) @@ -303,7 +303,7 @@ lemma mergeNaive_sorted_sorted [LinearOrder α] (xs ys : List α) simp_all [mergeNaive] | cons yhead ytail y_ih => simp only [mergeNaive] - by_cases hxy : xhead < yhead + by_cases hxy : xhead ≤ yhead · simp only [hxy, ↓reduceIte, List.pairwise_cons] refine ⟨?_, ?_⟩ · intro a a_mem @@ -324,7 +324,7 @@ lemma mergeNaive_sorted_sorted [LinearOrder α] (xs ys : List α) refine ⟨?_, ?_⟩ · intro a a_mem apply mergeNaive_mem at a_mem - simp_all only [List.pairwise_cons, not_lt, List.mem_cons, forall_const] + simp_all only [List.pairwise_cons, not_le, List.mem_cons, forall_const] obtain ⟨left, right⟩ := hxs_mono obtain ⟨left_1, right_1⟩ := hys_mono cases a_mem with @@ -332,7 +332,7 @@ lemma mergeNaive_sorted_sorted [LinearOrder α] (xs ys : List α) cases h with | inl h_1 => subst h_1 - simp_all only + grind | inr h_2 => grind | inr h_1 => simp_all only · simp_all From 5db32aa9b8d0cc872efe7dd44735749754cf1006 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 21 Feb 2026 03:18:24 +0100 Subject: [PATCH 095/176] All ready --- Cslib/AlgorithmsTheory/QueryModel.lean | 3 --- Cslib/Foundations/Control/Monad/Free.lean | 3 +++ 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index f3aea3b30..3e48ff857 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -66,9 +66,6 @@ which can determine the input and output types of a query. -/ abbrev Prog Q α := FreeM Q α -instance {Q α} : Coe (Q α) (FreeM Q α) where - coe := FreeM.lift - /-- The evaluation function of a program `P : Prog Q α` given a model `M : Model Q α` of `Q` -/ diff --git a/Cslib/Foundations/Control/Monad/Free.lean b/Cslib/Foundations/Control/Monad/Free.lean index 9cf40c322..44aecb4fb 100644 --- a/Cslib/Foundations/Control/Monad/Free.lean +++ b/Cslib/Foundations/Control/Monad/Free.lean @@ -223,6 +223,9 @@ lemma liftM_bind [LawfulMonad m] rw [FreeM.bind, liftM_liftBind, liftM_liftBind, bind_assoc] simp_rw [ih] +instance {Q α} : Coe (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 α`. From 6808a44dd3684621bce6cdb684a90f8553a168a9 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sat, 21 Feb 2026 03:21:24 +0100 Subject: [PATCH 096/176] Take the example suggestion. But this kinda defeats the point of that example --- CslibTests/QueryModel/ProgExamples.lean | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean index fd5dbe149..ce7e9ef1f 100644 --- a/CslibTests/QueryModel/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -35,11 +35,11 @@ def RatArithQuery_NatCost : Model (Arith ℚ) ℕ where cost _ := 1 open Arith in -def ex1 : Prog (Arith ℚ) ℚ := do - let mut x : ℚ ← @zero ℚ - let mut y ← @one ℚ - let z ← (add (x + y + y) y) - let w ← @neg ℚ (←(add z y)) +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 /-- From d9f105af9e3363526db65d2ed7b6d26a61b8b816 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Sun, 22 Feb 2026 04:06:21 +0100 Subject: [PATCH 097/176] Some indentation rule fixes --- .../Algorithms/ListInsertionSort.lean | 22 +++++---- .../Algorithms/ListLinearSearch.lean | 8 ++-- .../Algorithms/ListOrderedInsert.lean | 46 +++++++++---------- .../Algorithms/MergeSort.lean | 42 ++++++++--------- 4 files changed, 60 insertions(+), 58 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index 289ecc141..1e6e64c26 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -28,7 +28,7 @@ def insertionSort (l : List α) : Prog (SortOps α) (List α) := insertOrd x rest theorem insertionSort_sorted [LinearOrder α] (l : List α) : - ((insertionSort l).eval (sortModel α)).Pairwise (· ≤ ·) := by + ((insertionSort l).eval (sortModel α)).Pairwise (· ≤ ·) := by induction l with | nil => simp [insertionSort] @@ -38,25 +38,27 @@ theorem insertionSort_sorted [LinearOrder α] (l : List α) : exact h lemma insertionSort_time_compares [LinearOrder α] (head : α) (tail : List α) : - ((insertionSort (head :: tail)).time (sortModel α)).compares = - ((insertionSort tail).time (sortModel α)).compares + - ((insertOrd head ((insertionSort tail).eval (sortModel α))).time (sortModel α)).compares := by + ((insertionSort (head :: tail)).time (sortModel α)).compares = + ((insertionSort tail).time (sortModel α)).compares + + ((insertOrd head ((insertionSort tail).eval + (sortModel α))).time (sortModel α)).compares := by have h := congrArg SortOpsCost.compares (Prog.time.bind (M := sortModel α) (insertionSort tail) (fun rest => insertOrd head rest)) simp only [HAdd.hAdd, Add.add] at h simpa [insertionSort] using h lemma insertionSort_time_inserts [LinearOrder α] (head : α) (tail : List α) : - ((insertionSort (head :: tail)).time (sortModel α)).inserts = - ((insertionSort tail).time (sortModel α)).inserts + - ((insertOrd head ((insertionSort tail).eval (sortModel α))).time (sortModel α)).inserts := by + ((insertionSort (head :: tail)).time (sortModel α)).inserts = + ((insertionSort tail).time (sortModel α)).inserts + + ((insertOrd head ((insertionSort tail).eval (sortModel α))).time + (sortModel α)).inserts := by have h := congrArg SortOpsCost.inserts (Prog.time.bind (M := sortModel α) (insertionSort tail) (fun rest => insertOrd head rest)) simp only [HAdd.hAdd, Add.add] at h simpa [insertionSort] using h lemma insertionSort_length [LinearOrder α] (l : List α) : - ((insertionSort l).eval (sortModel α)).length = l.length := by + ((insertionSort l).eval (sortModel α)).length = l.length := by induction l with | nil => simp [insertionSort] @@ -66,8 +68,8 @@ lemma insertionSort_length [LinearOrder α] (l : List α) : simpa [insertionSort, ih] using h theorem insertionSort_complexity [LinearOrder α] (l : List α) : - ((insertionSort l).time (sortModel α)) - ≤ ⟨l.length * (l.length + 1), (l.length + 1) * (l.length + 2)⟩ := by + ((insertionSort l).time (sortModel α)) + ≤ ⟨l.length * (l.length + 1), (l.length + 1) * (l.length + 2)⟩ := by induction l with | nil => simp only [insertionSort, FreeM.pure_eq_pure, sortModel, diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index cf46c1893..cab9d7aac 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -35,7 +35,7 @@ def listLinearSearch (l : List α) (x : α) : Prog (ListSearch α) Bool := do listLinearSearch ls x lemma listLinearSearchM_correct_true [iDec : DecidableEq α] (l : List α) : - ∀ x : α, x ∈ l → (listLinearSearch l x).eval ListSearch_Nat = true := by + ∀ x : α, x ∈ l → (listLinearSearch l x).eval ListSearch_Nat = true := by intro x x_mem_l induction l with | nil => @@ -57,7 +57,7 @@ lemma listLinearSearchM_correct_true [iDec : DecidableEq α] (l : List α) : simp_all lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) : - ∀ x : α, x ∉ l → (listLinearSearch l x).eval ListSearch_Nat = false := by + ∀ x : α, x ∉ l → (listLinearSearch l x).eval ListSearch_Nat = false := by intro x x_mem_l induction l with | nil => @@ -74,7 +74,7 @@ lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) : · exact ih lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List α) : - ∀ x : α, (listLinearSearch l x).time ListSearch_Nat ≤ 1 + l.length := by + ∀ x : α, (listLinearSearch l x).time ListSearch_Nat ≤ 1 + l.length := by intro x induction l with | nil => @@ -86,7 +86,7 @@ lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List · grind lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Nontrivial α] : - ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = l.length := by + ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = l.length := by obtain ⟨x, y, x_neq_y⟩ := inon use [x,x,x,x,x,y], y simp_all [ListSearch_Nat, listLinearSearch] diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 8b12f7534..bb3b9c7da 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -36,9 +36,9 @@ def insertOrd (x : α) (l : List α) : Prog (SortOps α) (List α) := do insertHead a res lemma insertOrd_is_ListOrderedInsert [LinearOrder α] : - ∀ (x : α) (l : List α) , - l.Pairwise (· ≤ ·) → - (insertOrd x l).eval (sortModel α) = l.orderedInsert (· ≤ ·) x := by + ∀ (x : α) (l : List α) , + l.Pairwise (· ≤ ·) → + (insertOrd x l).eval (sortModel α) = l.orderedInsert (· ≤ ·) x := by intro x l h_sorted induction l with | nil => @@ -63,7 +63,7 @@ lemma insertOrd_is_ListOrderedInsert [LinearOrder α] : lemma insertOrd_length [LinearOrder α] (x : α) (l : List α) : - ((insertOrd x l).eval (sortModel α)).length = l.length + 1 := by + ((insertOrd x l).eval (sortModel α)).length = l.length + 1 := by induction l with | nil => simp [insertOrd, sortModel] @@ -74,11 +74,11 @@ lemma insertOrd_length [LinearOrder α] (x : α) (l : List α) : simpa [Prog.eval] using ih lemma bind_compares {α} (x tail head) [LinearOrder α] : - (Prog.time - (FreeM.bind (insertOrd x tail) - (fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) - (sortModel α)).compares = - (Prog.time (insertOrd x tail) (sortModel α)).compares := by + (Prog.time + (FreeM.bind (insertOrd x tail) + (fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) + (sortModel α)).compares = + (Prog.time (insertOrd x tail) (sortModel α)).compares := by have h := congrArg SortOpsCost.compares (Prog.time.bind (M := sortModel α) (op := insertOrd x tail) @@ -91,11 +91,11 @@ lemma bind_compares {α} (x tail head) [LinearOrder α] : lemma bind_inserts {α} (x tail head) [LinearOrder α] : - (Prog.time - (FreeM.bind (insertOrd x tail) - (fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) - (sortModel α)).inserts = - (Prog.time (insertOrd x tail) (sortModel α)).inserts + 1 := by + (Prog.time + (FreeM.bind (insertOrd x tail) + (fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) + (sortModel α)).inserts = + (Prog.time (insertOrd x tail) (sortModel α)).inserts + 1 := by have h := congrArg SortOpsCost.inserts (Prog.time.bind (M := sortModel α) (op := insertOrd x tail) @@ -110,23 +110,23 @@ lemma cost_cmpLT_compares [LinearOrder α] : ((sortModel α).2 (cmpLE head x)).c simp [sortModel] @[simp] -lemma cost_cmpLT_inserts [LinearOrder α] - : ((sortModel α).2 (cmpLE head x)).inserts = 0 := by +lemma cost_cmpLT_inserts [LinearOrder α] : + ((sortModel α).2 (cmpLE head x)).inserts = 0 := by simp [sortModel] @[simp] -lemma cost_insertHead_compares [LinearOrder α] - : ((sortModel α).2 (insertHead x l)).compares = 0 := by +lemma cost_insertHead_compares [LinearOrder α] : + ((sortModel α).2 (insertHead x l)).compares = 0 := by simp [sortModel] @[simp] -lemma cost_insertHead_inserts [LinearOrder α] - : ((sortModel α).2 (insertHead x l)).inserts = 1 := by +lemma cost_insertHead_inserts [LinearOrder α] : + ((sortModel α).2 (insertHead x l)).inserts = 1 := by simp [sortModel] theorem insertOrd_complexity_upper_bound [LinearOrder α] : - ∀ (l : List α) (x : α), - (insertOrd x l).time (sortModel α) ≤ ⟨l.length, l.length + 1⟩ := by + ∀ (l : List α) (x : α), + (insertOrd x l).time (sortModel α) ≤ ⟨l.length, l.length + 1⟩ := by intro l x induction l with | nil => @@ -158,7 +158,7 @@ theorem insertOrd_complexity_upper_bound [LinearOrder α] : lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : - l.Pairwise (· ≤ ·) → ((insertOrd x l).eval (sortModel α)).Pairwise (· ≤ ·) := by + l.Pairwise (· ≤ ·) → ((insertOrd x l).eval (sortModel α)).Pairwise (· ≤ ·) := by intro l_mono rw [insertOrd_is_ListOrderedInsert x l l_mono] apply List.Pairwise.orderedInsert diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 464abdee6..8ab1a9e64 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -33,7 +33,7 @@ def mergeNaive [LinearOrder α] (x y : List α) : List α := y :: rest lemma mergeNaive_length [LinearOrder α] (x y : List α) : - (mergeNaive x y).length = x.length + y.length := by + (mergeNaive x y).length = x.length + y.length := by fun_induction mergeNaive <;> try grind @@ -53,9 +53,9 @@ def merge (x y : List α) : Prog (SortOps α) (List α) := do return (y :: rest) lemma merge_bind_pure_insert_x [LinearOrder α] (x y : α) (xs ys : List α) : - (Prog.time - (FreeM.bind (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest))) (sortModelNat α)) - = (merge xs (y :: ys)).time (sortModelNat α) := by + (Prog.time + (FreeM.bind (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest))) (sortModelNat α)) + = (merge xs (y :: ys)).time (sortModelNat α) := by have h := Prog.time.bind (sortModelNat α) (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest)) have h' : Prog.time (FreeM.bind (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest))) @@ -64,9 +64,9 @@ lemma merge_bind_pure_insert_x [LinearOrder α] (x y : α) (xs ys : List α) : exact Nat.add_right_cancel h' lemma merge_bind_pure_insert_y [LinearOrder α] (x y : α) (xs ys : List α) : - (Prog.time - (FreeM.bind (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest))) (sortModelNat α)) - = (merge (x :: xs) ys).time (sortModelNat α) := by + (Prog.time + (FreeM.bind (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest))) (sortModelNat α)) + = (merge (x :: xs) ys).time (sortModelNat α) := by have h := Prog.time.bind (sortModelNat α) (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest)) have h' : Prog.time (FreeM.bind (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest))) @@ -75,7 +75,7 @@ lemma merge_bind_pure_insert_y [LinearOrder α] (x y : α) (xs ys : List α) : exact Nat.add_right_cancel h' lemma merge_timeComplexity [LinearOrder α] (x y : List α) : - (merge x y).time (sortModelNat α) ≤ x.length + y.length := by + (merge x y).time (sortModelNat α) ≤ x.length + y.length := by fun_induction merge · simp · simp @@ -104,7 +104,7 @@ lemma merge_timeComplexity [LinearOrder α] (x y : List α) : lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : - (merge x y).eval (sortModelNat α) = mergeNaive x y := by + (merge x y).eval (sortModelNat α) = mergeNaive x y := by fun_induction mergeNaive · simp [merge] · simp [merge] @@ -114,7 +114,7 @@ lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : simp_all [Prog.eval, merge, rest] lemma merge_length [LinearOrder α] (x y : List α) : - ((merge x y).eval (sortModelNat α)).length = x.length + y.length := by + ((merge x y).eval (sortModelNat α)).length = x.length + y.length := by rw [merge_is_mergeNaive] apply mergeNaive_length @@ -143,7 +143,7 @@ def mergeSortNaive [LinearOrder α] (xs : List α) : List α := mergeNaive sortedLeft sortedRight lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : - (mergeSort xs).eval (sortModelNat α) = mergeSortNaive xs := by + (mergeSort xs).eval (sortModelNat α) = mergeSortNaive xs := by classical let P : Nat → Prop := fun n => ∀ xs, xs.length = n → (mergeSort xs).eval (sortModelNat α) = mergeSortNaive xs @@ -220,7 +220,7 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : - (mergeSortNaive xs).length = xs.length := by + (mergeSortNaive xs).length = xs.length := by let P : Nat → Prop := fun n => ∀ ys : List α, ys.length = n → (mergeSortNaive ys).length = ys.length have hP : P xs.length := by @@ -260,13 +260,13 @@ lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : exact hP xs rfl lemma mergeSort_length [LinearOrder α] (xs : List α) : - ((mergeSort xs).eval (sortModelNat α)).length = xs.length := by + ((mergeSort xs).eval (sortModelNat α)).length = xs.length := by rw [mergeSort_is_mergeSortNaive] apply mergeSortNaive_length lemma mergeNaive_mem [LinearOrder α] (xs ys : List α) : - x ∈ mergeNaive xs ys → x ∈ xs ∨ x ∈ ys := by + x ∈ mergeNaive xs ys → x ∈ xs ∨ x ∈ ys := by fun_induction mergeNaive · simp · simp @@ -292,8 +292,8 @@ lemma mergeNaive_mem [LinearOrder α] (xs ys : List α) : tauto lemma mergeNaive_sorted_sorted [LinearOrder α] (xs ys : List α) - (hxs_mono : xs.Pairwise (· ≤ ·)) (hys_mono : ys.Pairwise (· ≤ ·)) : - (mergeNaive xs ys).Pairwise (· ≤ ·) := by + (hxs_mono : xs.Pairwise (· ≤ ·)) (hys_mono : ys.Pairwise (· ≤ ·)) : + (mergeNaive xs ys).Pairwise (· ≤ ·) := by induction xs generalizing ys with | nil => simp_all [mergeNaive] @@ -339,14 +339,14 @@ lemma mergeNaive_sorted_sorted [LinearOrder α] (xs ys : List α) lemma merge_sorted_sorted [LinearOrder α] (xs ys : List α) - (hxs_mono : xs.Pairwise (· ≤ ·)) (hys_mono : ys.Pairwise (· ≤ ·)) : - ((merge xs ys).eval (sortModelNat α)).Pairwise (· ≤ ·) := by + (hxs_mono : xs.Pairwise (· ≤ ·)) (hys_mono : ys.Pairwise (· ≤ ·)) : + ((merge xs ys).eval (sortModelNat α)).Pairwise (· ≤ ·) := by rw [merge_is_mergeNaive] apply mergeNaive_sorted_sorted all_goals assumption lemma mergeSortNaive_sorted [LinearOrder α] (xs : List α) : - (mergeSortNaive xs).Pairwise (· ≤ ·) := by + (mergeSortNaive xs).Pairwise (· ≤ ·) := by let P : Nat → Prop := fun n => ∀ ys : List α, ys.length = n → (mergeSortNaive ys).Pairwise (· ≤ ·) have hP : P xs.length := by @@ -392,7 +392,7 @@ lemma mergeSortNaive_sorted [LinearOrder α] (xs : List α) : exact hP xs rfl theorem mergeSort_sorted [LinearOrder α] (xs : List α) : - ((mergeSort xs).eval (sortModelNat α)).Pairwise (· ≤ ·) := by + ((mergeSort xs).eval (sortModelNat α)).Pairwise (· ≤ ·) := by rw [mergeSort_is_mergeSortNaive] apply mergeSortNaive_sorted @@ -442,7 +442,7 @@ lemma T_monotone : Monotone T := by exact Nat.mul_le_mul h_ij (Nat.clog_monotone 2 h_ij) theorem mergeSort_complexity [LinearOrder α] (xs : List α) : - ((mergeSort xs).time (sortModelNat α)) ≤ (T (xs.length)) := by + ((mergeSort xs).time (sortModelNat α)) ≤ (T (xs.length)) := by fun_induction mergeSort · simp [T] · expose_names From de4be8d60630bcd3e9715b3743777c32699dd850 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 00:15:28 +0100 Subject: [PATCH 098/176] Round one --- .../Algorithms/ListLinearSearch.lean | 30 ++++++++----------- .../Algorithms/ListOrderedInsert.lean | 2 -- .../Algorithms/MergeSort.lean | 10 ++----- .../Models/ListComparisonSort.lean | 28 +++++++++-------- 4 files changed, 31 insertions(+), 39 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index cab9d7aac..553a555ff 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -34,9 +34,8 @@ def listLinearSearch (l : List α) (x : α) : Prog (ListSearch α) Bool := do else listLinearSearch ls x -lemma listLinearSearchM_correct_true [iDec : DecidableEq α] (l : List α) : - ∀ x : α, x ∈ l → (listLinearSearch l x).eval ListSearch_Nat = true := by - intro x x_mem_l +lemma listLinearSearchM_correct_true [DecidableEq α] (l : List α) {x : α} (x_mem_l : x ∈ l) : + (listLinearSearch l x).eval ListSearch_Nat = true := by induction l with | nil => simp_all only [List.not_mem_nil] @@ -56,34 +55,31 @@ lemma listLinearSearchM_correct_true [iDec : DecidableEq α] (l : List α) : · specialize ih x_tail simp_all -lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) : - ∀ x : α, x ∉ l → (listLinearSearch l x).eval ListSearch_Nat = false := by - intro x x_mem_l +lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) {x : α} (x_mem_l : x ∉ l) : + (listLinearSearch l x).eval ListSearch_Nat = false := by induction l with | nil => simp_all [listLinearSearch, eval] | cons head tail ih => simp only [List.mem_cons, not_or] at x_mem_l specialize ih x_mem_l.2 - simp only [listLinearSearch, bind, FreeM.lift_def, pure, FreeM.liftBind_bind, FreeM.pure_bind, - eval, FreeM.liftM, Id.run] + simp only [eval, listLinearSearch, bind, FreeM.lift_def, FreeM.pure_eq_pure, + FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind] split_ifs with h_eq - · simp [ListSearch_Nat] at h_eq - exfalso - exact x_mem_l.1 h_eq.symm - · exact ih + · simp only [pure, ListSearch_Nat, List.head?_cons, Option.some.injEq, + decide_eq_true_eq] at h_eq + grind + · assumption -lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List α) : - ∀ x : α, (listLinearSearch l x).time ListSearch_Nat ≤ 1 + l.length := by - intro x +lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List α) (x : α) : + (listLinearSearch l x).time ListSearch_Nat ≤ 1 + l.length := by induction l with | nil => simp_all [listLinearSearch, ListSearch_Nat, time] | cons head tail ih => simp_all [listLinearSearch, ListSearch_Nat] split_ifs with h_head - · simp [time] - · grind + all_goals grind lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Nontrivial α] : ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = l.length := by diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index bb3b9c7da..74193a029 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -155,8 +155,6 @@ theorem insertOrd_complexity_upper_bound [LinearOrder α] : rw [bind_inserts] nlinarith [ih_inserts] - - lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : l.Pairwise (· ≤ ·) → ((insertOrd x l).eval (sortModel α)).Pairwise (· ≤ ·) := by intro l_mono diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 8ab1a9e64..183411db2 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -36,7 +36,6 @@ lemma mergeNaive_length [LinearOrder α] (x y : List α) : (mergeNaive x y).length = x.length + y.length := by fun_induction mergeNaive <;> try grind - /-- Merge two sorted lists using comparisons in the query monad. -/ @[simp] def merge (x y : List α) : Prog (SortOps α) (List α) := do @@ -166,19 +165,16 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : simpa [half] using (Nat.div_lt_self hpos h2) have hleft_le : left.length ≤ half := by simp [left, List.length_take] - have hleft_lt_len : left.length < xs.length := - lt_of_le_of_lt hleft_le hhalf_lt + have hleft_lt_len : left.length < xs.length := lt_of_le_of_lt hleft_le hhalf_lt have hright_lt_len : right.length < xs.length := by have hhalf_pos : 0 < half := by have h2 : 0 < (2 : Nat) := by decide simpa [half] using (Nat.div_pos hge h2) have hsub : xs.length - half < xs.length := Nat.sub_lt hpos hhalf_pos simpa [right, List.length_drop, half] using hsub - have hleft : - (mergeSort left).eval (sortModelNat α) = mergeSortNaive left := + have hleft : (mergeSort left).eval (sortModelNat α) = mergeSortNaive left := (ih left.length (by simpa [hlen] using hleft_lt_len)) left rfl - have hright : - (mergeSort right).eval (sortModelNat α) = mergeSortNaive right := + have hright : (mergeSort right).eval (sortModelNat α) = mergeSortNaive right := (ih right.length (by simpa [hlen] using hright_lt_len)) right rfl have hleft' : FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 5c0a2f9f2..149bd4527 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -40,12 +40,12 @@ structure SortOpsCost where /-- `inserts` counts the number of calls to `insertHead` -/ inserts : ℕ -@[simp, grind] +@[simps, grind] instance zeroSortOps : Zero SortOpsCost := ⟨0,0⟩ -@[simp, grind] +@[simps, grind] instance partialOrderSortOps : PartialOrder SortOpsCost where - le | ⟨c₁, i₁⟩, ⟨c₂, i₂⟩ => c₁ ≤ c₂ ∧ i₁ ≤ i₂ + le soc₁ soc₂ := soc₁.compares ≤ soc₂.compares ∧ soc₁.inserts ≤ soc₂.inserts le_refl := by intro c simp only [le_refl, and_self] @@ -61,21 +61,23 @@ instance partialOrderSortOps : PartialOrder SortOpsCost where refine ⟨?_, ?_⟩ all_goals solve_by_elim[Nat.le_antisymm] + /-- Component-wise addition operation on `SortOpsCost` -/ -def add : SortOpsCost → SortOpsCost → SortOpsCost - | ⟨c₁, i₁⟩, ⟨c₂, i₂⟩ => ⟨c₁ + c₂, i₁ + i₂⟩ +@[simps] +def add (soc₁ soc₂ : SortOpsCost) : SortOpsCost:= + ⟨soc₁.compares + soc₂.compares, soc₁.inserts + soc₂.inserts⟩ /-- Component-wise scalar (natural number) multiplication operation on `SortOpsCost` -/ -def nsmul : ℕ → SortOpsCost → SortOpsCost - | n, ⟨c, i⟩ => ⟨n • c, n • i⟩ +@[simps] +def nsmul (n : ℕ) (soc : SortOpsCost) : SortOpsCost := ⟨n • soc.compares, n • soc.inserts⟩ +@[simps!] instance acsSortOpsCost : AddCommMonoid SortOpsCost where add := add - add_assoc := by - intro a b c + add_assoc a b c := by simp only [HAdd.hAdd] - simp [add, Nat.add_assoc] + simp only [add, Nat.add_assoc] add_comm := by intro a b simp only [HAdd.hAdd] @@ -105,8 +107,7 @@ instance acsSortOpsCost : AddCommMonoid SortOpsCost where A model of `SortOps` that uses `SortOpsCost` as the cost type for operations. -/ def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where - evalQuery q := - match q with + evalQuery | .cmpLE x y => if x ≤ y then true @@ -157,7 +158,8 @@ end SortOpsCostModel section NatModel /-- -A model of `SortOps` that uses `ℕ` as the type for the cost of operations. +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. -/ def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where evalQuery From cd566569b49c3043ba8bee35f15cbb8363658c64 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 00:18:59 +0100 Subject: [PATCH 099/176] nlinarith not needed. linarith is enough --- Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 74193a029..8acb3e28e 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -144,7 +144,7 @@ theorem insertOrd_complexity_upper_bound [LinearOrder α] : (fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) (sortModel α)).compares ≤ tail.length + 1 rw [bind_compares] - nlinarith [ih_compares] + linarith [ih_compares] · simp only [sortModel, Bool.if_false_right, Bool.and_true, h_head, decide_false, FreeM.lift_def, FreeM.bind_eq_bind, FreeM.pure_bind, Bool.false_eq_true, ↓reduceIte, zero_add, List.length_cons] @@ -153,7 +153,7 @@ theorem insertOrd_complexity_upper_bound [LinearOrder α] : (fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) (sortModel α)).inserts ≤ tail.length + 1 + 1 rw [bind_inserts] - nlinarith [ih_inserts] + linarith [ih_inserts] lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : l.Pairwise (· ≤ ·) → ((insertOrd x l).eval (sortModel α)).Pairwise (· ≤ ·) := by From 523bd8c5f573613dbbdaf7ff8cd59cbd9ee3e36c Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 00:41:25 +0100 Subject: [PATCH 100/176] insertOrd_complexity_upper_bound has a shorter proof --- .../Algorithms/ListOrderedInsert.lean | 33 ++++++------------- .../Models/ListComparisonSort.lean | 29 +++++----------- 2 files changed, 19 insertions(+), 43 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 8acb3e28e..d85dde1b5 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -73,6 +73,7 @@ lemma insertOrd_length [LinearOrder α] (x : α) (l : List α) : · simp [insertOrd, sortModel, h_head] simpa [Prog.eval] using ih +@[simp] lemma bind_compares {α} (x tail head) [LinearOrder α] : (Prog.time (FreeM.bind (insertOrd x tail) @@ -84,12 +85,12 @@ lemma bind_compares {α} (x tail head) [LinearOrder α] : (op := insertOrd x tail) (cont := fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) simp only [FreeM.bind_eq_bind, sortModel, Bool.if_false_right, - Bool.and_true, HAdd.hAdd, time, eval, SortModel_add_compares] at h + Bool.and_true, HAdd.hAdd, time, eval] at h simp only [Add.add] at h simp_all only [sortModel, Bool.if_false_right, Bool.and_true] rfl - +@[simp] lemma bind_inserts {α} (x tail head) [LinearOrder α] : (Prog.time (FreeM.bind (insertOrd x tail) @@ -101,7 +102,7 @@ lemma bind_inserts {α} (x tail head) [LinearOrder α] : (op := insertOrd x tail) (cont := fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) simp only [HAdd.hAdd, bind, sortModel, Bool.if_false_right, - Bool.and_true, SortModel_add_inserts, time, eval] at h + Bool.and_true, time, eval] at h simp only [Add.add] at h exact h @@ -133,27 +134,13 @@ theorem insertOrd_complexity_upper_bound [LinearOrder α] : simp [insertOrd, sortModel] | cons head tail ih => obtain ⟨ih_compares, ih_inserts⟩ := ih - by_cases h_head : x ≤ head - · constructor <;> simp [sortModel, h_head] + simp [insertOrd] + split_ifs with h_head + · constructor <;> simp_all · constructor - · simp only [sortModel, Bool.if_false_right, Bool.and_true, h_head, decide_false, - FreeM.lift_def, FreeM.bind_eq_bind, FreeM.pure_bind, Bool.false_eq_true, ↓reduceIte, - List.length_cons] - change 1 + (Prog.time - (FreeM.bind (insertOrd x tail) - (fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) - (sortModel α)).compares ≤ tail.length + 1 - rw [bind_compares] - linarith [ih_compares] - · simp only [sortModel, Bool.if_false_right, Bool.and_true, h_head, decide_false, - FreeM.lift_def, FreeM.bind_eq_bind, FreeM.pure_bind, Bool.false_eq_true, ↓reduceIte, - zero_add, List.length_cons] - change (Prog.time - (FreeM.bind (insertOrd x tail) - (fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) - (sortModel α)).inserts ≤ tail.length + 1 + 1 - rw [bind_inserts] - linarith [ih_inserts] + · simp_all + grind + · simp_all lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : l.Pairwise (· ≤ ·) → ((insertOrd x l).eval (sortModel α)).Pairwise (· ≤ ·) := by diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 149bd4527..aabbb7c14 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -121,36 +121,25 @@ def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost wher @[grind =] lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : - (sortModel α).evalQuery (cmpLE x y) ↔ x ≤ y := by + (sortModel α).evalQuery (cmpLE x y) ↔ x ≤ y := by simp [sortModel] @[grind =] lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : - (sortModel α).evalQuery (insertHead x l) = x :: l := by + (sortModel α).evalQuery (insertHead x l) = x :: l := by simp [sortModel] lemma SortModel_addComponents (m₁ m₂ m₃ : SortOpsCost) : - m₁ + m₂ = m₃ ↔ - m₁.compares + m₂.compares = m₃.compares ∧ - m₁.inserts + m₂.inserts = m₃.inserts := by - simp only [HAdd.hAdd] + m₁ + m₂ = m₃ ↔ + m₁.compares + m₂.compares = m₃.compares ∧ + m₁.inserts + m₂.inserts = m₃.inserts := by aesop -@[simp] -lemma SortModel_add_compares (m₁ m₂ : SortOpsCost) : - (Add.add m₁ m₂).compares = m₁.compares + m₂.compares := by - cases m₁; cases m₂; rfl - -@[simp] -lemma SortModel_add_inserts (m₁ m₂ : SortOpsCost) : - (Add.add m₁ m₂).inserts = m₁.inserts + m₂.inserts := by - cases m₁; cases m₂; rfl - lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : - m₁ ≤ m₂ ↔ - m₁.compares ≤ m₂.compares ∧ - m₁.inserts ≤ m₂.inserts := by + m₁ ≤ m₂ ↔ + m₁.compares ≤ m₂.compares ∧ + m₁.inserts ≤ m₂.inserts := by simp only [LE.le] end SortOpsCostModel @@ -175,7 +164,7 @@ def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where @[simp] lemma sortModelNat_eval_1 [LinearOrder α] (y x : α) : - y < x → (sortModelNat α).evalQuery (cmpLE x y) = false := by + y < x → (sortModelNat α).evalQuery (cmpLE x y) = false := by intro h simp only [sortModelNat, Bool.if_false_right, Bool.and_true, decide_eq_false_iff_not, not_le] exact h From 5a165ccdf89a945f988d7caec68c3a0310e9505f Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 00:42:03 +0100 Subject: [PATCH 101/176] use simp only's --- Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index d85dde1b5..759843cdb 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -134,11 +134,14 @@ theorem insertOrd_complexity_upper_bound [LinearOrder α] : simp [insertOrd, sortModel] | cons head tail ih => obtain ⟨ih_compares, ih_inserts⟩ := ih - simp [insertOrd] + simp only [insertOrd, FreeM.lift_def, FreeM.bind_eq_bind, FreeM.liftBind_bind, + FreeM.pure_bind, time.eq_2, List.length_cons, partialOrderSortOps_le, + acsSortOpsCost_add_compares, cost_cmpLT_compares, acsSortOpsCost_add_inserts, + cost_cmpLT_inserts, zero_add] split_ifs with h_head · constructor <;> simp_all · constructor - · simp_all + · simp_all only [Bool.not_eq_true, bind_compares] grind · simp_all From fcf4b3cee4664ac799dcec91eeb6c3c965f157fb Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 01:05:35 +0100 Subject: [PATCH 102/176] Golf some mergeSort proofs with grind --- .../Algorithms/MergeSort.lean | 64 ++++++------------- .../Models/ListComparisonSort.lean | 32 +++++----- 2 files changed, 35 insertions(+), 61 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 183411db2..4687dc5c4 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -150,8 +150,7 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : refine Nat.strong_induction_on (n := xs.length) ?_ intro n ih xs hlen by_cases hlt : xs.length < 2 - · nth_rewrite 1 [mergeSort] - nth_rewrite 1 [mergeSortNaive] + · nth_rw 1 [mergeSort, mergeSortNaive] simp [hlt, Prog.eval] · have hge : 2 ≤ xs.length := by exact le_of_not_gt hlt @@ -190,8 +189,8 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b) = mergeNaive a b := by simpa [Prog.eval, Id.run] using (merge_is_mergeNaive (α := α) a b) - nth_rewrite 1 [mergeSort] - nth_rewrite 1 [mergeSortNaive] + nth_rw 1 [mergeSort] + nth_rw 1 [mergeSortNaive] simp only [hlt, if_false, Prog.eval, Id.run, bind, pure, FreeM.liftM_bind] set a := FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) @@ -214,7 +213,6 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : simp only [a, b, hleft', hright'] exact hP xs rfl - lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : (mergeSortNaive xs).length = xs.length := by let P : Nat → Prop := @@ -226,29 +224,17 @@ lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : · simp [mergeSortNaive, hlt] · have hge : 2 ≤ ys.length := le_of_not_gt hlt have hpos : 0 < ys.length := lt_of_lt_of_le (by decide : 0 < (2 : Nat)) hge - have hhalf_lt : ys.length / 2 < ys.length := by - have htwo : 1 < (2 : Nat) := by decide - simpa using Nat.div_lt_self hpos htwo + have hhalf_lt : ys.length / 2 < ys.length := by grind have htake_lt : (ys.take (ys.length / 2)).length < ys.length := by - have htake_le : (ys.take (ys.length / 2)).length ≤ ys.length / 2 := by - simp [List.length_take] - exact lt_of_le_of_lt htake_le hhalf_lt + simp only [List.length_take, inf_lt_right, not_le] + grind have hdrop_lt : (ys.drop (ys.length / 2)).length < ys.length := by - have hhalf_pos : 0 < ys.length / 2 := by - have htwo : 0 < (2 : Nat) := by decide - simpa using Nat.div_pos hge htwo - have hsub : ys.length - ys.length / 2 < ys.length := Nat.sub_lt hpos hhalf_pos - simpa [List.length_drop] using hsub - have hleft : - (mergeSortNaive (ys.take (ys.length / 2))).length = - (ys.take (ys.length / 2)).length := by - exact ih (ys.take (ys.length / 2)).length - (by simpa [hlen] using htake_lt) (ys.take (ys.length / 2)) rfl - have hright : - (mergeSortNaive (ys.drop (ys.length / 2))).length = - (ys.drop (ys.length / 2)).length := by - exact ih (ys.drop (ys.length / 2)).length - (by simpa [hlen] using hdrop_lt) (ys.drop (ys.length / 2)) rfl + simp only [List.length_drop, tsub_lt_self_iff, Nat.div_pos_iff, Nat.zero_lt_succ, true_and] + grind + have hleft : (mergeSortNaive (ys.take (ys.length / 2))).length = + (ys.take (ys.length / 2)).length := by grind + have hright : (mergeSortNaive (ys.drop (ys.length / 2))).length = + (ys.drop (ys.length / 2)).length := by grind have hdiv_le : ys.length / 2 ≤ ys.length := Nat.div_le_self _ _ rw [mergeSortNaive] simp [hlt, mergeNaive_length, hleft, hright, List.length_take, List.length_drop, @@ -360,27 +346,15 @@ lemma mergeSortNaive_sorted [LinearOrder α] (xs : List α) : exact (Nat.not_lt_of_ge (by simp) hlt).elim · have hge : 2 ≤ ys.length := le_of_not_gt hlt have hpos : 0 < ys.length := lt_of_lt_of_le (by decide : 0 < (2 : Nat)) hge - have hhalf_lt : ys.length / 2 < ys.length := by - have htwo : 1 < (2 : Nat) := by decide - simpa using Nat.div_lt_self hpos htwo + have hhalf_lt : ys.length / 2 < ys.length := by grind have htake_lt : (ys.take (ys.length / 2)).length < ys.length := by - have htake_le : (ys.take (ys.length / 2)).length ≤ ys.length / 2 := by - simp [List.length_take] - exact lt_of_le_of_lt htake_le hhalf_lt + simp only [List.length_take, inf_lt_right, not_le] + grind have hdrop_lt : (ys.drop (ys.length / 2)).length < ys.length := by - have hhalf_pos : 0 < ys.length / 2 := by - have htwo : 0 < (2 : Nat) := by decide - simpa using Nat.div_pos hge htwo - have hsub : ys.length - ys.length / 2 < ys.length := Nat.sub_lt hpos hhalf_pos - simpa [List.length_drop] using hsub - have hleft : - (mergeSortNaive (ys.take (ys.length / 2))).Pairwise (· ≤ ·) := by - exact ih (ys.take (ys.length / 2)).length - (by simpa [hlen] using htake_lt) (ys.take (ys.length / 2)) rfl - have hright : - (mergeSortNaive (ys.drop (ys.length / 2))).Pairwise (· ≤ ·) := by - exact ih (ys.drop (ys.length / 2)).length - (by simpa [hlen] using hdrop_lt) (ys.drop (ys.length / 2)) rfl + simp only [List.length_drop, tsub_lt_self_iff, Nat.div_pos_iff, Nat.zero_lt_succ, true_and] + grind + have hleft : (mergeSortNaive (ys.take (ys.length / 2))).Pairwise (· ≤ ·) := by grind + have hright : (mergeSortNaive (ys.drop (ys.length / 2))).Pairwise (· ≤ ·) := by grind rw [mergeSortNaive] simpa [hlt] using mergeNaive_sorted_sorted (mergeSortNaive (ys.take (ys.length / 2))) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index aabbb7c14..f19318bed 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -43,20 +43,23 @@ structure SortOpsCost where @[simps, grind] instance zeroSortOps : Zero SortOpsCost := ⟨0,0⟩ -@[simps, grind] -instance partialOrderSortOps : PartialOrder SortOpsCost where +@[simps] +instance : LE SortOpsCost where le soc₁ soc₂ := soc₁.compares ≤ soc₂.compares ∧ soc₁.inserts ≤ soc₂.inserts + +@[simps!, grind] +instance partialOrderSortOps : PartialOrder SortOpsCost where le_refl := by intro c - simp only [le_refl, and_self] + simp le_trans a b c := by - simp only [and_imp] + simp only [le_def, and_imp] intro ab_comps ab_inserts bc_comps bc_inserts refine ⟨?_, ?_⟩ all_goals solve_by_elim [Nat.le_trans] le_antisymm := by intro ⟨a_comps, a_inserts⟩ ⟨b_comps, b_inserts⟩ - simp only [SortOpsCost.mk.injEq, and_imp] + simp only [le_def, SortOpsCost.mk.injEq, and_imp] intro ab_comps ab_inserts ba_comps ba_inserts refine ⟨?_, ?_⟩ all_goals solve_by_elim[Nat.le_antisymm] @@ -71,32 +74,29 @@ def add (soc₁ soc₂ : SortOpsCost) : SortOpsCost:= @[simps] def nsmul (n : ℕ) (soc : SortOpsCost) : SortOpsCost := ⟨n • soc.compares, n • soc.inserts⟩ +@[simps] +instance AddSortOps : Add SortOpsCost where + add := add @[simps!] instance acsSortOpsCost : AddCommMonoid SortOpsCost where - add := add add_assoc a b c := by - simp only [HAdd.hAdd] - simp only [add, Nat.add_assoc] + simp only [AddSortOps_add, add, Nat.add_assoc] add_comm := by intro a b - simp only [HAdd.hAdd] - simp [add, Nat.add_comm] + simp only [AddSortOps_add, add, Nat.add_comm] zero_add := by intro ⟨c, i⟩ - simp only [HAdd.hAdd, Add.add, add] - simp + simp only [AddSortOps_add, add, zeroSortOps_zero_compares, zero_add, zeroSortOps_zero_inserts] + add_zero := by intro ⟨c, i⟩ - simp only [HAdd.hAdd, add] - simp [Add.add] - + simp [add] nsmul := nsmul nsmul_zero := by intro x rw [nsmul, zero_nsmul, zero_nsmul] rfl - nsmul_succ := by intro n x rw [nsmul, succ_nsmul, succ_nsmul] From 29a8d968c882fee02c699a7e0ade58bf6eb0b37a Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 02:07:35 +0100 Subject: [PATCH 103/176] Golf some mergeSort proofs with grind --- .../Algorithms/MergeSort.lean | 47 +++++++------------ 1 file changed, 16 insertions(+), 31 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 4687dc5c4..0113053d5 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -152,29 +152,17 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : by_cases hlt : xs.length < 2 · nth_rw 1 [mergeSort, mergeSortNaive] simp [hlt, Prog.eval] - · have hge : 2 ≤ xs.length := by - exact le_of_not_gt hlt - have hpos : 0 < xs.length := by - exact lt_of_lt_of_le (by decide : 0 < (2 : Nat)) hge + · have hge : 2 ≤ xs.length := by grind + have hpos : 0 < xs.length := by grind set half : Nat := xs.length / 2 set left : List α := xs.take half set right : List α := xs.drop half - have hhalf_lt : half < xs.length := by - have h2 : 1 < (2 : Nat) := by decide - simpa [half] using (Nat.div_lt_self hpos h2) - have hleft_le : left.length ≤ half := by - simp [left, List.length_take] - have hleft_lt_len : left.length < xs.length := lt_of_le_of_lt hleft_le hhalf_lt - have hright_lt_len : right.length < xs.length := by - have hhalf_pos : 0 < half := by - have h2 : 0 < (2 : Nat) := by decide - simpa [half] using (Nat.div_pos hge h2) - have hsub : xs.length - half < xs.length := Nat.sub_lt hpos hhalf_pos - simpa [right, List.length_drop, half] using hsub - have hleft : (mergeSort left).eval (sortModelNat α) = mergeSortNaive left := - (ih left.length (by simpa [hlen] using hleft_lt_len)) left rfl - have hright : (mergeSort right).eval (sortModelNat α) = mergeSortNaive right := - (ih right.length (by simpa [hlen] using hright_lt_len)) right rfl + have hhalf_lt : half < xs.length := by grind + have hleft_le : left.length ≤ half := by grind + have hleft_lt_len : left.length < xs.length := by grind + have hright_lt_len : right.length < xs.length := by grind + have hleft : (mergeSort left).eval (sortModelNat α) = mergeSortNaive left := by grind + have hright : (mergeSort right).eval (sortModelNat α) = mergeSortNaive right := by grind have hleft' : FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (mergeSort (xs.take (xs.length / 2))) = @@ -188,16 +176,14 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : have hmerge (a b : List α) : FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b) = mergeNaive a b := by - simpa [Prog.eval, Id.run] using (merge_is_mergeNaive (α := α) a b) + simpa [Prog.eval] using (merge_is_mergeNaive (α := α) a b) nth_rw 1 [mergeSort] nth_rw 1 [mergeSortNaive] simp only [hlt, if_false, Prog.eval, Id.run, bind, pure, FreeM.liftM_bind] - set a := - FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) - (mergeSort (List.take (xs.length / 2) xs)) - set b := - FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) - (mergeSort (List.drop (xs.length / 2) xs)) + set a := FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) + (mergeSort (List.take (xs.length / 2) xs)) with ha + set b := FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) + (mergeSort (List.drop (xs.length / 2) xs)) with hb calc FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (merge @@ -207,7 +193,7 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : (mergeSort (List.drop (xs.length / 2) xs)))) = FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b) := by simp [a, b] - _ = mergeNaive a b := hmerge a b + _ = mergeNaive a b := by apply hmerge a b _ = mergeNaive (mergeSortNaive (List.take (xs.length / 2) xs)) (mergeSortNaive (List.drop (xs.length / 2) xs)) := by simp only [a, b, hleft', hright'] @@ -256,14 +242,13 @@ lemma mergeNaive_mem [LinearOrder α] (xs ys : List α) : intro h simp only [List.mem_cons] at h obtain h | h := h - · left - simp [h] + · simp [h] · simp only [rest] at h specialize ih1 h obtain ih | ih := ih1 · simp only [List.mem_cons] tauto - · right; exact ih + · simp [ih] · expose_names intro h simp only [List.mem_cons, rest] at h From 26b2f15eb6417d17507a163063a4d2b596bbc6c6 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 02:09:39 +0100 Subject: [PATCH 104/176] fix naming in test files --- CslibTests/QueryModel/ProgExamples.lean | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean index ce7e9ef1f..3e614f337 100644 --- a/CslibTests/QueryModel/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -52,7 +52,7 @@ inductive VecSortOps (α : Type) : Type → Type where | read : (a : Vector α n) → (i : Fin n) → VecSortOps α α | push : (a : Vector α n) → (elem : α) → VecSortOps α (Vector α (n + 1)) -def VecSort_WorstCase [DecidableEq α] : Model (VecSortOps α) ℕ where +def VecSortOps.worstCase [DecidableEq α] : Model (VecSortOps α) ℕ where evalQuery | .write v i x => v.set i x | .cmp l i j => l[i] == l[j] @@ -66,7 +66,7 @@ def VecSort_WorstCase [DecidableEq α] : Model (VecSortOps α) ℕ where | .swap l i j => 1 | .push a elem => 2 -- amortized over array insertion and resizing by doubling -def VecSort_CmpSwap [DecidableEq α] : Model (VecSortOps α) ℕ where +def VecSortOps.cmpSwap [DecidableEq α] : Model (VecSortOps α) ℕ where evalQuery | .write v i x => v.set i x | .cmp l i j => l[i] == l[j] @@ -89,7 +89,7 @@ def simpleExample (v : Vector ℤ n) (i k : Fin n) inductive VecSearch (α : Type) : Type → Type where | compare (a : Vector α n) (i : ℕ) (val : α) : VecSearch α Bool -def VecSearch_Nat [DecidableEq α] : Model (VecSearch α) ℕ where +def VecSearch.nat [DecidableEq α] : Model (VecSearch α) ℕ where evalQuery | .compare l i x => l[i]? == some x cost From ac25d60d35fd12f95edcd7cf2fbf0436a68e17c1 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 02:11:17 +0100 Subject: [PATCH 105/176] Fix names --- CslibTests/QueryModel/QueryExamples.lean | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/CslibTests/QueryModel/QueryExamples.lean b/CslibTests/QueryModel/QueryExamples.lean index 19bfcb987..65140e83c 100644 --- a/CslibTests/QueryModel/QueryExamples.lean +++ b/CslibTests/QueryModel/QueryExamples.lean @@ -28,7 +28,7 @@ inductive ListOps (α : Type) : Type → Type where | find (l : List α) (elem : α) : ListOps α ℕ | write (l : List α) (i : Fin l.length) (x : α) : ListOps α (List α) -def List_LinSearch_WorstCase [DecidableEq α] : Model (ListOps α) ℕ where +def ListOps.linSearchWorstCase [DecidableEq α] : Model (ListOps α) ℕ where evalQuery | .write l i x => l.set i x | .find l elem => l.findIdx (· = elem) @@ -38,7 +38,7 @@ def List_LinSearch_WorstCase [DecidableEq α] : Model (ListOps α) ℕ where | .find l elem => l.length | .get l i => l.length -def List_BinSearch_WorstCase [BEq α] : Model (ListOps α) ℕ where +def ListOps.binSearchWorstCase [BEq α] : Model (ListOps α) ℕ where evalQuery | .write l i x => l.set i x | .get l i => l[i] @@ -55,7 +55,7 @@ inductive ArrayOps (α : Type) : Type → Type where | write : (l : Array α) → (i : Fin l.size) → (x : α) → ArrayOps α (Array α) -def Array_BinSearch_WorstCase [BEq α] : Model (ArrayOps α) ℕ where +def ArrayOps.binSearchWorstCase [BEq α] : Model (ArrayOps α) ℕ where evalQuery | .write l i x => l.set i x | .get l i => l[i] From fc281c64cbfc1d1b1f945820cef005f2ca9e4564 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 02:20:48 +0100 Subject: [PATCH 106/176] Linebreak --- Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean | 1 - 1 file changed, 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index f19318bed..f871c7b8a 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -88,7 +88,6 @@ instance acsSortOpsCost : AddCommMonoid SortOpsCost where zero_add := by intro ⟨c, i⟩ simp only [AddSortOps_add, add, zeroSortOps_zero_compares, zero_add, zeroSortOps_zero_inserts] - add_zero := by intro ⟨c, i⟩ simp [add] From a1733b9fedbe20c8f73d4af9c19263e9b60951ac Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 02:33:51 +0100 Subject: [PATCH 107/176] acsSortOps --- .../Models/ListComparisonSort.lean | 50 ++++++++++--------- 1 file changed, 27 insertions(+), 23 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index f871c7b8a..88480893b 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -40,6 +40,20 @@ structure SortOpsCost where /-- `inserts` counts the number of calls to `insertHead` -/ inserts : ℕ +def SortOpsCost.ofProd : ℕ × ℕ ↪ SortOpsCost where + toFun pair := ⟨pair.1, pair.2⟩ + inj' := by + unfold Function.Injective + intro (_,_) (_, _) + simp only [mk.injEq, Prod.mk.injEq, imp_self] + +def SortOpsCost.toProd : SortOpsCost ↪ ℕ × ℕ where + toFun pair := (pair.compares, pair.inserts) + inj' := by + unfold Function.Injective + intro ⟨_,_⟩ ⟨_,_⟩ + simp only [mk.injEq, Prod.mk.injEq, imp_self] + @[simps, grind] instance zeroSortOps : Zero SortOpsCost := ⟨0,0⟩ @@ -78,29 +92,19 @@ def nsmul (n : ℕ) (soc : SortOpsCost) : SortOpsCost := ⟨n • soc.compares, instance AddSortOps : Add SortOpsCost where add := add -@[simps!] -instance acsSortOpsCost : AddCommMonoid SortOpsCost where - add_assoc a b c := by - simp only [AddSortOps_add, add, Nat.add_assoc] - add_comm := by - intro a b - simp only [AddSortOps_add, add, Nat.add_comm] - zero_add := by - intro ⟨c, i⟩ - simp only [AddSortOps_add, add, zeroSortOps_zero_compares, zero_add, zeroSortOps_zero_inserts] - add_zero := by - intro ⟨c, i⟩ - simp [add] - nsmul := nsmul - nsmul_zero := by - intro x - rw [nsmul, zero_nsmul, zero_nsmul] - rfl - nsmul_succ := by - intro n x - rw [nsmul, succ_nsmul, succ_nsmul] - rfl - +@[simps] +instance SMulSortOps : SMul ℕ SortOpsCost where + smul := nsmul + + +instance acsSortOpsCost : AddCommMonoid SortOpsCost := by + apply Function.Injective.addCommMonoid SortOpsCost.toProd + · exact SortOpsCost.toProd.inj' + · simp [SortOpsCost.toProd] + · intro ⟨xcomp, xins⟩ ⟨ycomp, yins⟩ + simp [SortOpsCost.toProd, add] + · intro x n + simp [SortOpsCost.toProd] /-- A model of `SortOps` that uses `SortOpsCost` as the cost type for operations. From 5a6137a0a2c90cc2ca929fa77c88d2bd363931a8 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 02:50:39 +0100 Subject: [PATCH 108/176] Instances improved. API lemmas for sortOps moved to sortops file --- .../Algorithms/ListOrderedInsert.lean | 26 ++-------- .../Models/ListComparisonSort.lean | 48 +++++++++++++------ 2 files changed, 36 insertions(+), 38 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 759843cdb..65fa2e16c 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -106,25 +106,6 @@ lemma bind_inserts {α} (x tail head) [LinearOrder α] : simp only [Add.add] at h exact h -@[simp] -lemma cost_cmpLT_compares [LinearOrder α] : ((sortModel α).2 (cmpLE head x)).compares = 1 := by - simp [sortModel] - -@[simp] -lemma cost_cmpLT_inserts [LinearOrder α] : - ((sortModel α).2 (cmpLE head x)).inserts = 0 := by - simp [sortModel] - -@[simp] -lemma cost_insertHead_compares [LinearOrder α] : - ((sortModel α).2 (insertHead x l)).compares = 0 := by - simp [sortModel] - -@[simp] -lemma cost_insertHead_inserts [LinearOrder α] : - ((sortModel α).2 (insertHead x l)).inserts = 1 := by - simp [sortModel] - theorem insertOrd_complexity_upper_bound [LinearOrder α] : ∀ (l : List α) (x : α), (insertOrd x l).time (sortModel α) ≤ ⟨l.length, l.length + 1⟩ := by @@ -135,13 +116,12 @@ theorem insertOrd_complexity_upper_bound [LinearOrder α] : | cons head tail ih => obtain ⟨ih_compares, ih_inserts⟩ := ih simp only [insertOrd, FreeM.lift_def, FreeM.bind_eq_bind, FreeM.liftBind_bind, - FreeM.pure_bind, time.eq_2, List.length_cons, partialOrderSortOps_le, - acsSortOpsCost_add_compares, cost_cmpLT_compares, acsSortOpsCost_add_inserts, - cost_cmpLT_inserts, zero_add] + FreeM.pure_bind, time.eq_2, List.length_cons, partialOrderSortOps_le] split_ifs with h_head · constructor <;> simp_all · constructor - · simp_all only [Bool.not_eq_true, bind_compares] + · simp_all only [Bool.not_eq_true, AddSortOps_add, add_compares, cost_cmpLT_compares, + bind_compares] grind · simp_all diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 88480893b..b902e5543 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -61,23 +61,22 @@ instance zeroSortOps : Zero SortOpsCost := ⟨0,0⟩ instance : LE SortOpsCost where le soc₁ soc₂ := soc₁.compares ≤ soc₂.compares ∧ soc₁.inserts ≤ soc₂.inserts +@[simps] +instance : LT SortOpsCost where + lt soc₁ soc₂ := soc₁ ≤ soc₂ ∧ (soc₁.compares < soc₂.compares ∨ soc₁.inserts < soc₂.inserts) + @[simps!, grind] -instance partialOrderSortOps : PartialOrder SortOpsCost where - le_refl := by - intro c - simp - le_trans a b c := by - simp only [le_def, and_imp] - intro ab_comps ab_inserts bc_comps bc_inserts - refine ⟨?_, ?_⟩ - all_goals solve_by_elim [Nat.le_trans] - le_antisymm := by - intro ⟨a_comps, a_inserts⟩ ⟨b_comps, b_inserts⟩ - simp only [le_def, SortOpsCost.mk.injEq, and_imp] - intro ab_comps ab_inserts ba_comps ba_inserts +instance partialOrderSortOps : PartialOrder SortOpsCost := by + apply Function.Injective.partialOrder SortOpsCost.toProd + · exact SortOpsCost.toProd.inj' + · simp [SortOpsCost.toProd] + · intro x y + simp only [SortOpsCost.toProd, Function.Embedding.coeFn_mk, Prod.mk_lt_mk, lt_def, le_def] refine ⟨?_, ?_⟩ - all_goals solve_by_elim[Nat.le_antisymm] - + · rintro (⟨h_compares, h_inserts⟩ | ⟨h_compares, h_inserts⟩) + all_goals grind only + · rintro ⟨h_leq, (h | h)⟩ + all_goals grind only /-- Component-wise addition operation on `SortOpsCost` -/ @[simps] @@ -145,6 +144,25 @@ lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : m₁.inserts ≤ m₂.inserts := by simp only [LE.le] +@[simp] +lemma cost_cmpLT_compares [LinearOrder α] : ((sortModel α).2 (cmpLE head x)).compares = 1 := by + simp [sortModel] + +@[simp] +lemma cost_cmpLT_inserts [LinearOrder α] : + ((sortModel α).2 (cmpLE head x)).inserts = 0 := by + simp [sortModel] + +@[simp] +lemma cost_insertHead_compares [LinearOrder α] : + ((sortModel α).2 (insertHead x l)).compares = 0 := by + simp [sortModel] + +@[simp] +lemma cost_insertHead_inserts [LinearOrder α] : + ((sortModel α).2 (insertHead x l)).inserts = 1 := by + simp [sortModel] + end SortOpsCostModel section NatModel From 8eefce58cc468b744aafedee30817c3673cb6882 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 02:54:05 +0100 Subject: [PATCH 109/176] remove Id.run and pure and bind from simp lemma sets --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 0113053d5..7c1006367 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -167,19 +167,19 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (mergeSort (xs.take (xs.length / 2))) = mergeSortNaive (xs.take (xs.length / 2)) := by - simpa [left, half, Prog.eval, Id.run] using hleft + simpa [left, half, Prog.eval] using hleft have hright' : FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (mergeSort (xs.drop (xs.length / 2))) = mergeSortNaive (xs.drop (xs.length / 2)) := by - simpa [right, half, Prog.eval, Id.run] using hright + simpa [right, half, Prog.eval] using hright have hmerge (a b : List α) : FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b) = mergeNaive a b := by simpa [Prog.eval] using (merge_is_mergeNaive (α := α) a b) nth_rw 1 [mergeSort] nth_rw 1 [mergeSortNaive] - simp only [hlt, if_false, Prog.eval, Id.run, bind, pure, FreeM.liftM_bind] + simp only [hlt, if_false, Prog.eval, bind, FreeM.liftM_bind] set a := FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (mergeSort (List.take (xs.length / 2) xs)) with ha set b := FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) From e62cc443d661259a9132fc8d10c9c87275f4822b Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 02:59:39 +0100 Subject: [PATCH 110/176] Fix docblame error --- .../Models/ListComparisonSort.lean | 23 +++++++------------ 1 file changed, 8 insertions(+), 15 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index b902e5543..d6f20936a 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -40,6 +40,9 @@ structure SortOpsCost where /-- `inserts` counts the number of calls to `insertHead` -/ inserts : ℕ +/-- +Injective mapping from a pair of ℕ to SortOpsCost +-/ def SortOpsCost.ofProd : ℕ × ℕ ↪ SortOpsCost where toFun pair := ⟨pair.1, pair.2⟩ inj' := by @@ -47,6 +50,9 @@ def SortOpsCost.ofProd : ℕ × ℕ ↪ SortOpsCost where intro (_,_) (_, _) simp only [mk.injEq, Prod.mk.injEq, imp_self] +/-- +Injective mapping from SortOpsCost to a pair of ℕ +-/ def SortOpsCost.toProd : SortOpsCost ↪ ℕ × ℕ where toFun pair := (pair.compares, pair.inserts) inj' := by @@ -79,12 +85,12 @@ instance partialOrderSortOps : PartialOrder SortOpsCost := by all_goals grind only /-- Component-wise addition operation on `SortOpsCost` -/ -@[simps] +@[inline, simps] def add (soc₁ soc₂ : SortOpsCost) : SortOpsCost:= ⟨soc₁.compares + soc₂.compares, soc₁.inserts + soc₂.inserts⟩ /-- Component-wise scalar (natural number) multiplication operation on `SortOpsCost` -/ -@[simps] +@[inline, simps] def nsmul (n : ℕ) (soc : SortOpsCost) : SortOpsCost := ⟨n • soc.compares, n • soc.inserts⟩ @[simps] @@ -131,19 +137,6 @@ lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : (sortModel α).evalQuery (insertHead x l) = x :: l := by simp [sortModel] - -lemma SortModel_addComponents (m₁ m₂ m₃ : SortOpsCost) : - m₁ + m₂ = m₃ ↔ - m₁.compares + m₂.compares = m₃.compares ∧ - m₁.inserts + m₂.inserts = m₃.inserts := by - aesop - -lemma SortModel_leComponents (m₁ m₂ : SortOpsCost) : - m₁ ≤ m₂ ↔ - m₁.compares ≤ m₂.compares ∧ - m₁.inserts ≤ m₂.inserts := by - simp only [LE.le] - @[simp] lemma cost_cmpLT_compares [LinearOrder α] : ((sortModel α).2 (cmpLE head x)).compares = 1 := by simp [sortModel] From 6b8883282f096128236ba15cead3aeabfca51177 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 03:11:01 +0100 Subject: [PATCH 111/176] TimeM abbrev added. Prog.time untouched --- Cslib/AlgorithmsTheory/QueryModel.lean | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 3e48ff857..7ee9694cf 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -8,7 +8,7 @@ module public import Mathlib public import Cslib.Foundations.Control.Monad.Free.Fold -public import Batteries +public import Cslib.AlgorithmsTheory.Lean.TimeM @[expose] public section @@ -45,7 +45,9 @@ and complexity of algorithms in lean. To specify an algorithm, one must: query model, free monad, time complexity, Prog -/ -namespace Cslib.Algorithms +namespace Cslib + +namespace Algorithms /-- A model type for a query type `QType` and cost type `Cost`. It consists of @@ -60,6 +62,11 @@ structure Model (QType : Type u → Type u) (Cost : Type) including but not limited to time complexity -/ cost : QType ι → Cost +open Cslib.Algorithms.Lean in +abbrev Model.timeQuery [AddCommMonoid Cost] + (M : Model Q Cost) (x : Q ι) : TimeM Cost ι := do + TimeM.tick (M.cost x); return (M.evalQuery 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. From 63680f1b4deba44b91633a5c9685bf1efa261067 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 03:51:41 +0100 Subject: [PATCH 112/176] One sorry remains --- .../Algorithms/ListInsertionSort.lean | 4 +- .../Algorithms/ListLinearSearch.lean | 3 +- .../Algorithms/ListOrderedInsert.lean | 25 +++++---- .../Algorithms/MergeSort.lean | 51 ++++--------------- Cslib/AlgorithmsTheory/Lean/TimeM.lean | 4 +- .../Models/ListComparisonSort.lean | 14 ++--- Cslib/AlgorithmsTheory/QueryModel.lean | 10 ++-- 7 files changed, 35 insertions(+), 76 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index 1e6e64c26..13b2f0d1c 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -72,8 +72,8 @@ theorem insertionSort_complexity [LinearOrder α] (l : List α) : ≤ ⟨l.length * (l.length + 1), (l.length + 1) * (l.length + 2)⟩ := by induction l with | nil => - simp only [insertionSort, FreeM.pure_eq_pure, sortModel, - Bool.if_false_right, Bool.and_true, time.eq_1, List.length_nil, zero_add, mul_one, one_mul] + simp only [insertionSort, FreeM.pure_eq_pure, sortModel, time.eq_1, List.length_nil, + zero_add, mul_one, one_mul] tauto | cons head tail ih => have h := insertOrd_complexity_upper_bound ((insertionSort tail).eval (sortModel α)) head diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index 553a555ff..abf563747 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -79,7 +79,8 @@ lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List | cons head tail ih => simp_all [listLinearSearch, ListSearch_Nat] split_ifs with h_head - all_goals grind + · simp + · grind lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Nontrivial α] : ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = l.length := by diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 65fa2e16c..27204cb63 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -84,10 +84,12 @@ lemma bind_compares {α} (x tail head) [LinearOrder α] : (Prog.time.bind (M := sortModel α) (op := insertOrd x tail) (cont := fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) - simp only [FreeM.bind_eq_bind, sortModel, Bool.if_false_right, - Bool.and_true, HAdd.hAdd, time, eval] at h - simp only [Add.add] at h - simp_all only [sortModel, Bool.if_false_right, Bool.and_true] + simp only [time, sortModel, bind_pure_comp, + FreeM.bind_eq_bind, FreeM.liftM_bind, FreeM.liftM_liftBind, FreeM.liftM_pure, bind_pure, + Lean.TimeM.time_bind, HAdd.hAdd, Lean.TimeM.time_map, eval] at h + simp_all only [time, sortModel, bind_pure_comp, + FreeM.liftM_bind, FreeM.liftM_liftBind, FreeM.liftM_pure, bind_pure, Lean.TimeM.time_bind, + Lean.TimeM.time_map, AddSortOps_add, add_compares, Nat.add_eq_left] rfl @[simp] @@ -101,9 +103,7 @@ lemma bind_inserts {α} (x tail head) [LinearOrder α] : (Prog.time.bind (M := sortModel α) (op := insertOrd x tail) (cont := fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) - simp only [HAdd.hAdd, bind, sortModel, Bool.if_false_right, - Bool.and_true, time, eval] at h - simp only [Add.add] at h + simp only [sortModel, time, eval] at h exact h theorem insertOrd_complexity_upper_bound [LinearOrder α] : @@ -115,13 +115,16 @@ theorem insertOrd_complexity_upper_bound [LinearOrder α] : simp [insertOrd, sortModel] | cons head tail ih => obtain ⟨ih_compares, ih_inserts⟩ := ih - simp only [insertOrd, FreeM.lift_def, FreeM.bind_eq_bind, FreeM.liftBind_bind, - FreeM.pure_bind, time.eq_2, List.length_cons, partialOrderSortOps_le] + simp only [time, bind_pure_comp, insertOrd, FreeM.lift_def, FreeM.bind_eq_bind, + FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, bind_map_left, + Lean.TimeM.time_bind, AddSortOps_add, List.length_cons, le_def, add_compares, add_inserts] split_ifs with h_head · constructor <;> simp_all · constructor - · simp_all only [Bool.not_eq_true, AddSortOps_add, add_compares, cost_cmpLT_compares, - bind_compares] + · simp_all only [time, bind_pure_comp, Bool.not_eq_true, Lean.TimeM.time_tick, + cost_cmpLT_compares, FreeM.liftM_bind, FreeM.liftM_liftBind, FreeM.liftM_pure, bind_pure, + Lean.TimeM.time_bind, Lean.TimeM.time_map, AddSortOps_add, add_compares, + cost_insertHead_compares, add_zero] grind · simp_all diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 7c1006367..d043c0555 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -51,55 +51,22 @@ def merge (x y : List α) : Prog (SortOps α) (List α) := do let rest ← merge (x :: xs') ys' return (y :: rest) -lemma merge_bind_pure_insert_x [LinearOrder α] (x y : α) (xs ys : List α) : - (Prog.time - (FreeM.bind (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest))) (sortModelNat α)) - = (merge xs (y :: ys)).time (sortModelNat α) := by - have h := Prog.time.bind (sortModelNat α) (merge xs (y :: ys)) - (fun rest => FreeM.pure (x :: rest)) - have h' : Prog.time (FreeM.bind (merge xs (y :: ys)) (fun rest => FreeM.pure (x :: rest))) - (sortModelNat α) + 1 = (merge xs (y :: ys)).time (sortModelNat α) + 1 := by - simpa using h - exact Nat.add_right_cancel h' - -lemma merge_bind_pure_insert_y [LinearOrder α] (x y : α) (xs ys : List α) : - (Prog.time - (FreeM.bind (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest))) (sortModelNat α)) - = (merge (x :: xs) ys).time (sortModelNat α) := by - have h := Prog.time.bind (sortModelNat α) (merge (x :: xs) ys) - (fun rest => FreeM.pure (y :: rest)) - have h' : Prog.time (FreeM.bind (merge (x :: xs) ys) (fun rest => FreeM.pure (y :: rest))) - (sortModelNat α) + 1 = (merge (x :: xs) ys).time (sortModelNat α) + 1 := by - simpa using h - exact Nat.add_right_cancel h' - lemma merge_timeComplexity [LinearOrder α] (x y : List α) : (merge x y).time (sortModelNat α) ≤ x.length + y.length := by fun_induction merge · simp · simp · expose_names - simp only [bind, FreeM.lift_def, pure, FreeM.liftBind_bind, FreeM.pure_bind, sortModelNat, - Bool.if_false_right, Bool.and_true, Prog.time.eq_2, decide_eq_true_eq, List.length_cons] + simp_all only [Prog.time, pure, + List.length_cons, FreeM.lift_def, FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, + FreeM.liftM_liftBind, bind_assoc, Lean.TimeM.time_bind, Lean.TimeM.time_tick] split_ifs with hxy - · have hbind := merge_bind_pure_insert_x x y xs' ys' - simp only [sortModelNat, Bool.if_false_right, Bool.and_true] at hbind - rw [hbind] - have hih : - (merge xs' (y :: ys')).time (sortModelNat α) ≤ - xs'.length + (y :: ys').length := by - simpa using ih2 - have h := Nat.add_le_add_left hih 1 - simpa [List.length_cons, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using h - · have hbind := merge_bind_pure_insert_y x y xs' ys' - simp only [sortModelNat, Bool.if_false_right, Bool.and_true] at hbind - rw [hbind] - have hih : - (merge (x :: xs') ys').time (sortModelNat α) ≤ - (x :: xs').length + ys'.length := by - simpa using ih1 - have h := Nat.add_le_add_left hih 1 - simpa [List.length_cons, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using h + · simp_all only [FreeM.liftM_bind, FreeM.liftM_pure, bind_pure_comp, Lean.TimeM.time_map] + sorry + · simp_all only [Bool.not_eq_true, FreeM.liftM_bind, FreeM.liftM_pure, bind_pure_comp, + Lean.TimeM.time_map] + sorry + lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : diff --git a/Cslib/AlgorithmsTheory/Lean/TimeM.lean b/Cslib/AlgorithmsTheory/Lean/TimeM.lean index 2509e175c..707f9346a 100644 --- a/Cslib/AlgorithmsTheory/Lean/TimeM.lean +++ b/Cslib/AlgorithmsTheory/Lean/TimeM.lean @@ -125,8 +125,8 @@ instance [AddMonoid T] : LawfulMonad (TimeM T) := .mk' /-- Creates a `TimeM` computation with a time cost. -/ def tick (c : T) : TimeM T PUnit := ⟨.unit, c⟩ -@[simp, grind =] theorem ret_tick (c : ℕ) : (tick c).ret = () := rfl -@[simp, grind =] theorem time_tick (c : ℕ) : (tick c).time = c := rfl +@[simp, grind =] theorem ret_tick (c : T) : (tick c).ret = () := rfl +@[simp, grind =] theorem time_tick (c : T) : (tick c).time = c := rfl /-- `✓[c] x` adds `c` ticks, then executes `x`. -/ macro "✓[" c:term "]" body:doElem : doElem => `(doElem| do TimeM.tick $c; $body:doElem) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index d6f20936a..79941a56a 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -116,11 +116,7 @@ A model of `SortOps` that uses `SortOpsCost` as the cost type for operations. -/ def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where evalQuery - | .cmpLE x y => - if x ≤ y then - true - else - false + | .cmpLE x y => decide (x ≤ y) | .insertHead x l => x :: l cost q := match q with @@ -166,11 +162,7 @@ both comparisons and insertions are counted in a single `ℕ` parameter. -/ def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where evalQuery - | .cmpLE x y => - if x ≤ y then - true - else - false + | .cmpLE x y => decide (x ≤ y) | .insertHead x l => x :: l cost | .cmpLE _ _ => 1 @@ -180,7 +172,7 @@ def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where lemma sortModelNat_eval_1 [LinearOrder α] (y x : α) : y < x → (sortModelNat α).evalQuery (cmpLE x y) = false := by intro h - simp only [sortModelNat, Bool.if_false_right, Bool.and_true, decide_eq_false_iff_not, not_le] + simp only [sortModelNat, decide_eq_false_iff_not, not_le] exact h end NatModel diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 7ee9694cf..a61fbf36d 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -88,12 +88,7 @@ The most common use case of this function is to compute time-complexity, hence t @[simp, grind] def Prog.time [AddCommMonoid Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := - match P with - | .pure _ => 0 - | .liftBind op cont => - let t₁ := M.cost op - let qval := M.evalQuery op - t₁ + (time (cont qval) M) + (P.liftM fun x => do Lean.TimeM.tick (M.cost x); return (M.evalQuery x)).time @[grind =] lemma Prog.time.bind_pure [AddCommMonoid Cost] (M : Model Q Cost) : @@ -117,7 +112,8 @@ lemma Prog.time.bind [AddCommMonoid Cost] (M : Model Q Cost) simp | liftBind op cont' ih => specialize ih (M.evalQuery op) - simp_all only [time, FreeM.liftBind_bind, FreeM.liftM_liftBind, LawfulMonad.pure_bind] + simp_all only [time, bind_pure_comp, FreeM.liftM_bind, Lean.TimeM.time_bind, + FreeM.liftBind_bind, FreeM.liftM_liftBind, bind_map_left, LawfulMonad.pure_bind] rw [add_assoc] @[simp, grind =] From 174e86bfa63578f768cd3b4991dbd57aebf10fa8 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 12:13:54 +0100 Subject: [PATCH 113/176] Apparently induction syntax is better --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index d043c0555..17f83720c 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -114,8 +114,9 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : let P : Nat → Prop := fun n => ∀ xs, xs.length = n → (mergeSort xs).eval (sortModelNat α) = mergeSortNaive xs have hP : P xs.length := by - refine Nat.strong_induction_on (n := xs.length) ?_ - intro n ih xs hlen + induction hlen : xs.length using Nat.strong_induction_on generalizing xs with + | h n ih => + intro xs hlen by_cases hlt : xs.length < 2 · nth_rw 1 [mergeSort, mergeSortNaive] simp [hlt, Prog.eval] @@ -171,8 +172,9 @@ lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : let P : Nat → Prop := fun n => ∀ ys : List α, ys.length = n → (mergeSortNaive ys).length = ys.length have hP : P xs.length := by - refine Nat.strong_induction_on xs.length ?_ - intro n ih ys hlen + induction hlen : xs.length using Nat.strong_induction_on generalizing xs with + | h n ih => + intro ys hlen by_cases hlt : ys.length < 2 · simp [mergeSortNaive, hlt] · have hge : 2 ≤ ys.length := le_of_not_gt hlt From e13c74b379645ed9b803244b77f2e12b9c73bf91 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 12:41:08 +0100 Subject: [PATCH 114/176] sorry free again --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 17f83720c..ca301e0f7 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -62,12 +62,12 @@ lemma merge_timeComplexity [LinearOrder α] (x y : List α) : FreeM.liftM_liftBind, bind_assoc, Lean.TimeM.time_bind, Lean.TimeM.time_tick] split_ifs with hxy · simp_all only [FreeM.liftM_bind, FreeM.liftM_pure, bind_pure_comp, Lean.TimeM.time_map] - sorry + have h := Nat.add_le_add_left ih2 1 + simpa [sortModelNat, Lean.TimeM.pure, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using h · simp_all only [Bool.not_eq_true, FreeM.liftM_bind, FreeM.liftM_pure, bind_pure_comp, Lean.TimeM.time_map] - sorry - - + have h := Nat.add_le_add_left ih1 1 + simpa [sortModelNat, Lean.TimeM.pure, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using h lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : (merge x y).eval (sortModelNat α) = mergeNaive x y := by From 8144aaca85bfdc75c5a5abb24ef6ae54b6135d9f Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 12:41:50 +0100 Subject: [PATCH 115/176] sorry free again --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index ca301e0f7..8bf6ecd5e 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -145,8 +145,7 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b) = mergeNaive a b := by simpa [Prog.eval] using (merge_is_mergeNaive (α := α) a b) - nth_rw 1 [mergeSort] - nth_rw 1 [mergeSortNaive] + nth_rw 1 [mergeSort, mergeSortNaive] simp only [hlt, if_false, Prog.eval, bind, FreeM.liftM_bind] set a := FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (mergeSort (List.take (xs.length / 2) xs)) with ha From 43373c6dab24724718e83e26eb65ca409207b7ba Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 12:42:44 +0100 Subject: [PATCH 116/176] sorry free again --- Cslib/AlgorithmsTheory/QueryModel.lean | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index a61fbf36d..fe78cd618 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -78,7 +78,7 @@ The evaluation function of a program `P : Prog Q α` given a model `M : Model Q -/ @[simp, grind] def Prog.eval [AddCommMonoid Cost] - (P : Prog Q α) (M : Model Q Cost) : α := + (P : Prog Q α) (M : Model Q Cost) : α := Id.run <| P.liftM fun x => pure (M.evalQuery x) /-- @@ -87,25 +87,25 @@ The most common use case of this function is to compute time-complexity, hence t -/ @[simp, grind] def Prog.time [AddCommMonoid Cost] - (P : Prog Q α) (M : Model Q Cost) : Cost := + (P : Prog Q α) (M : Model Q Cost) : Cost := (P.liftM fun x => do Lean.TimeM.tick (M.cost x); return (M.evalQuery x)).time @[grind =] lemma Prog.time.bind_pure [AddCommMonoid Cost] (M : Model Q Cost) : - Prog.time (op >>= FreeM.pure) M = (Prog.time op M) := by + Prog.time (op >>= FreeM.pure) M = (Prog.time op M) := by simp only [bind, FreeM.bind_pure] @[grind =] lemma Prog.time.pure_bind - [AddCommMonoid Cost] (M : Model Q Cost) : - Prog.time (FreeM.pure x >>= m) M = (m x).time M := by + [AddCommMonoid Cost] (M : Model Q Cost) : + Prog.time (FreeM.pure x >>= m) M = (m x).time M := by rfl @[grind =] lemma Prog.time.bind [AddCommMonoid Cost] (M : Model Q Cost) - (op : Prog Q ι) (cont : ι → Prog Q α) : - Prog.time (op >>= cont) M = - (Prog.time op M) + (Prog.time (cont (Prog.eval op M)) M):= by + (op : Prog Q ι) (cont : ι → Prog Q α) : + Prog.time (op >>= cont) M = + (Prog.time op M) + (Prog.time (cont (Prog.eval op M)) M):= by simp only [FreeM.bind_eq_bind, eval] induction op with | pure a => @@ -118,9 +118,9 @@ lemma Prog.time.bind [AddCommMonoid Cost] (M : Model Q Cost) @[simp, grind =] lemma Prog.time.liftBind [AddCommMonoid Cost] (M : Model Q Cost) - (op : Q ι) (cont : ι → Prog Q α) : - Prog.time (.liftBind op cont) M = - (Prog.time (FreeM.lift op) M) + (Prog.time (cont (M.evalQuery op)) M):= by + (op : Q ι) (cont : ι → Prog Q α) : + Prog.time (.liftBind op cont) M = + (Prog.time (FreeM.lift op) M) + (Prog.time (cont (M.evalQuery op)) M):= by simp [time, FreeM.lift_def] section Reduction @@ -137,8 +137,8 @@ structure Reduction (Q₁ Q₂ : Type u → Type u) where `Prog.reduceProg` takes a reduction structure from a query `Q₁` to `Q₂` and extends its `reduce` function to programs on the query type `Q₁` -/ -def Prog.reduceProg (P : Prog Q₁ α) (red : Reduction Q₁ Q₂) : Prog Q₂ α := - P.liftM red.reduce +abbrev Prog.reduceProg (P : Prog Q₁ α) (red : Reduction Q₁ Q₂) : Prog Q₂ α := + P.liftM red.reduce end Reduction From fd4f8bd71e1fab601f0ffc690150c52dc3903544 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 12:45:37 +0100 Subject: [PATCH 117/176] sorry free again --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 8bf6ecd5e..09a0556dc 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -62,12 +62,12 @@ lemma merge_timeComplexity [LinearOrder α] (x y : List α) : FreeM.liftM_liftBind, bind_assoc, Lean.TimeM.time_bind, Lean.TimeM.time_tick] split_ifs with hxy · simp_all only [FreeM.liftM_bind, FreeM.liftM_pure, bind_pure_comp, Lean.TimeM.time_map] - have h := Nat.add_le_add_left ih2 1 - simpa [sortModelNat, Lean.TimeM.pure, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using h + simpa [sortModelNat, Lean.TimeM.pure, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] + using (Nat.add_le_add_left ih2 1) · simp_all only [Bool.not_eq_true, FreeM.liftM_bind, FreeM.liftM_pure, bind_pure_comp, Lean.TimeM.time_map] - have h := Nat.add_le_add_left ih1 1 - simpa [sortModelNat, Lean.TimeM.pure, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using h + simpa [sortModelNat, Lean.TimeM.pure, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] + using (Nat.add_le_add_left ih1 1) lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : (merge x y).eval (sortModelNat α) = mergeNaive x y := by From 7f2ca28203e44078b12e896572ed47a876f21ef6 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 13:50:10 +0100 Subject: [PATCH 118/176] docstring --- .../Algorithms/ListOrderedInsert.lean | 33 ------------------- Cslib/AlgorithmsTheory/QueryModel.lean | 9 +++-- 2 files changed, 7 insertions(+), 35 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 27204cb63..542dcee7e 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -73,39 +73,6 @@ lemma insertOrd_length [LinearOrder α] (x : α) (l : List α) : · simp [insertOrd, sortModel, h_head] simpa [Prog.eval] using ih -@[simp] -lemma bind_compares {α} (x tail head) [LinearOrder α] : - (Prog.time - (FreeM.bind (insertOrd x tail) - (fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) - (sortModel α)).compares = - (Prog.time (insertOrd x tail) (sortModel α)).compares := by - have h := congrArg SortOpsCost.compares - (Prog.time.bind (M := sortModel α) - (op := insertOrd x tail) - (cont := fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) - simp only [time, sortModel, bind_pure_comp, - FreeM.bind_eq_bind, FreeM.liftM_bind, FreeM.liftM_liftBind, FreeM.liftM_pure, bind_pure, - Lean.TimeM.time_bind, HAdd.hAdd, Lean.TimeM.time_map, eval] at h - simp_all only [time, sortModel, bind_pure_comp, - FreeM.liftM_bind, FreeM.liftM_liftBind, FreeM.liftM_pure, bind_pure, Lean.TimeM.time_bind, - Lean.TimeM.time_map, AddSortOps_add, add_compares, Nat.add_eq_left] - rfl - -@[simp] -lemma bind_inserts {α} (x tail head) [LinearOrder α] : - (Prog.time - (FreeM.bind (insertOrd x tail) - (fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) - (sortModel α)).inserts = - (Prog.time (insertOrd x tail) (sortModel α)).inserts + 1 := by - have h := congrArg SortOpsCost.inserts - (Prog.time.bind (M := sortModel α) - (op := insertOrd x tail) - (cont := fun res => FreeM.liftBind (insertHead head res) FreeM.pure)) - simp only [sortModel, time, eval] at h - exact h - theorem insertOrd_complexity_upper_bound [LinearOrder α] : ∀ (l : List α) (x : α), (insertOrd x l).time (sortModel α) ≤ ⟨l.length, l.length + 1⟩ := by diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index fe78cd618..bbbe1eb82 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -62,7 +62,11 @@ structure Model (QType : Type u → Type u) (Cost : Type) including but not limited to time complexity -/ cost : QType ι → Cost + open Cslib.Algorithms.Lean in +/-- +lift `Model.cost` to `TimeM Cost ι` +-/ abbrev Model.timeQuery [AddCommMonoid Cost] (M : Model Q Cost) (x : Q ι) : TimeM Cost ι := do TimeM.tick (M.cost x); return (M.evalQuery x) @@ -116,12 +120,13 @@ lemma Prog.time.bind [AddCommMonoid Cost] (M : Model Q Cost) FreeM.liftBind_bind, FreeM.liftM_liftBind, bind_map_left, LawfulMonad.pure_bind] rw [add_assoc] -@[simp, grind =] +@[grind =] lemma Prog.time.liftBind [AddCommMonoid Cost] (M : Model Q Cost) (op : Q ι) (cont : ι → Prog Q α) : Prog.time (.liftBind op cont) M = (Prog.time (FreeM.lift op) M) + (Prog.time (cont (M.evalQuery op)) M):= by - simp [time, FreeM.lift_def] + simp only [time, bind_pure_comp, FreeM.liftM_liftBind, bind_map_left, Lean.TimeM.time_bind, + Lean.TimeM.time_tick, FreeM.lift_def, FreeM.liftM_pure, _root_.bind_pure, Lean.TimeM.time_map] section Reduction From 7e57d1548fcdc7b19e35894933bd6cf5c2559a5e Mon Sep 17 00:00:00 2001 From: Shreyas Date: Mon, 23 Feb 2026 13:52:33 +0100 Subject: [PATCH 119/176] Docstring --- Cslib/AlgorithmsTheory/QueryModel.lean | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index bbbe1eb82..e728b545b 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -64,9 +64,7 @@ structure Model (QType : Type u → Type u) (Cost : Type) open Cslib.Algorithms.Lean in -/-- -lift `Model.cost` to `TimeM Cost ι` --/ +/-- lift `Model.cost` to `TimeM Cost ι` -/ abbrev Model.timeQuery [AddCommMonoid Cost] (M : Model Q Cost) (x : Q ι) : TimeM Cost ι := do TimeM.tick (M.cost x); return (M.evalQuery x) From ac70600865b8221b9c9c3daccab242e09f5bda4d Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 00:39:54 +0100 Subject: [PATCH 120/176] Some review fixes --- Cslib/AlgorithmsTheory/QueryModel.lean | 8 +++----- Cslib/Foundations/Control/Monad/Free.lean | 2 +- CslibTests/QueryModel/ProgExamples.lean | 6 +++--- 3 files changed, 7 insertions(+), 9 deletions(-) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index e728b545b..1d884f063 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -36,9 +36,8 @@ and complexity of algorithms in lean. To specify an algorithm, one must: 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 one or more cost types `C` and instances of `PureCosts` for this cost type. -3. Define a `Model Q C` type instance -4. Write your algorithm as a monadic program in `Prog Q α`. With sufficient type anotations +2. Define a `Model Q C` type instance +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 @@ -53,8 +52,7 @@ 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 u) (Cost : Type) - [AddCommMonoid Cost] where +structure Model (QType : Type u → Type u) (Cost : Type) [AddCommMonoid Cost] 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`. diff --git a/Cslib/Foundations/Control/Monad/Free.lean b/Cslib/Foundations/Control/Monad/Free.lean index 44aecb4fb..bb12f636f 100644 --- a/Cslib/Foundations/Control/Monad/Free.lean +++ b/Cslib/Foundations/Control/Monad/Free.lean @@ -223,7 +223,7 @@ lemma liftM_bind [LawfulMonad m] rw [FreeM.bind, liftM_liftBind, liftM_liftBind, bind_assoc] simp_rw [ih] -instance {Q α} : Coe (Q α) (FreeM Q α) where +instance {Q α} : CoeOut (Q α) (FreeM Q α) where coe := FreeM.lift /-- diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean index 3e614f337..bd98c224e 100644 --- a/CslibTests/QueryModel/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -25,13 +25,13 @@ inductive Arith (α : Type) : Type → Type where | zero : Arith α α | one : Arith α α -def RatArithQuery_NatCost : Model (Arith ℚ) ℕ where +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 : ℚ) + | .zero => 0 + | .one => 1 cost _ := 1 open Arith in From 0011bde557d49bebf863058cff982f1d32081a95 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 00:42:38 +0100 Subject: [PATCH 121/176] Other review fixes --- Cslib/AlgorithmsTheory/QueryModel.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 1d884f063..e4cd4127a 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -88,7 +88,7 @@ The most common use case of this function is to compute time-complexity, hence t @[simp, grind] def Prog.time [AddCommMonoid Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := - (P.liftM fun x => do Lean.TimeM.tick (M.cost x); return (M.evalQuery x)).time + (P.liftM M.timeQuery).time @[grind =] lemma Prog.time.bind_pure [AddCommMonoid Cost] (M : Model Q Cost) : From afa3b0b79a04de0ee0ef5dd143a24475451cb72d Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 00:47:06 +0100 Subject: [PATCH 122/176] Other review fixes --- Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 79941a56a..77fb69366 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -118,8 +118,7 @@ def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost wher evalQuery | .cmpLE x y => decide (x ≤ y) | .insertHead x l => x :: l - cost q := - match q with + cost | .cmpLE _ _ => ⟨1,0⟩ | .insertHead _ _ => ⟨0,1⟩ From e0d71bac9a4a32480fd7306c7720f16d95e05d9b Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 00:50:00 +0100 Subject: [PATCH 123/176] Manual inlines --- .../Models/ListComparisonSort.lean | 16 +++------------- 1 file changed, 3 insertions(+), 13 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 77fb69366..0d416a0e6 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -84,30 +84,20 @@ instance partialOrderSortOps : PartialOrder SortOpsCost := by · rintro ⟨h_leq, (h | h)⟩ all_goals grind only -/-- Component-wise addition operation on `SortOpsCost` -/ -@[inline, simps] -def add (soc₁ soc₂ : SortOpsCost) : SortOpsCost:= - ⟨soc₁.compares + soc₂.compares, soc₁.inserts + soc₂.inserts⟩ - -/-- Component-wise scalar (natural number) multiplication operation on `SortOpsCost` -/ -@[inline, simps] -def nsmul (n : ℕ) (soc : SortOpsCost) : SortOpsCost := ⟨n • soc.compares, n • soc.inserts⟩ - @[simps] instance AddSortOps : Add SortOpsCost where - add := add + add (soc₁ soc₂ : SortOpsCost) := ⟨soc₁.compares + soc₂.compares, soc₁.inserts + soc₂.inserts⟩ @[simps] instance SMulSortOps : SMul ℕ SortOpsCost where - smul := nsmul - + smul (n : ℕ) (soc : SortOpsCost) : SortOpsCost := ⟨n • soc.compares, n • soc.inserts⟩ instance acsSortOpsCost : AddCommMonoid SortOpsCost := by apply Function.Injective.addCommMonoid SortOpsCost.toProd · exact SortOpsCost.toProd.inj' · simp [SortOpsCost.toProd] · intro ⟨xcomp, xins⟩ ⟨ycomp, yins⟩ - simp [SortOpsCost.toProd, add] + simp [SortOpsCost.toProd] · intro x n simp [SortOpsCost.toProd] From 7f939eb4c70442501064f7502ff576af219d6900 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 00:51:20 +0100 Subject: [PATCH 124/176] rfls --- Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 0d416a0e6..86050c15d 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -95,11 +95,11 @@ instance SMulSortOps : SMul ℕ SortOpsCost where instance acsSortOpsCost : AddCommMonoid SortOpsCost := by apply Function.Injective.addCommMonoid SortOpsCost.toProd · exact SortOpsCost.toProd.inj' - · simp [SortOpsCost.toProd] + · rfl · intro ⟨xcomp, xins⟩ ⟨ycomp, yins⟩ - simp [SortOpsCost.toProd] + rfl · intro x n - simp [SortOpsCost.toProd] + rfl /-- A model of `SortOps` that uses `SortOpsCost` as the cost type for operations. From 9be8cb6887320c095d2c86ef95720d3c6219caf6 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 00:53:43 +0100 Subject: [PATCH 125/176] rfls --- 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 86050c15d..7337b4945 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -92,7 +92,7 @@ instance AddSortOps : Add SortOpsCost where instance SMulSortOps : SMul ℕ SortOpsCost where smul (n : ℕ) (soc : SortOpsCost) : SortOpsCost := ⟨n • soc.compares, n • soc.inserts⟩ -instance acsSortOpsCost : AddCommMonoid SortOpsCost := by +instance : AddCommMonoid SortOpsCost := by apply Function.Injective.addCommMonoid SortOpsCost.toProd · exact SortOpsCost.toProd.inj' · rfl From 03a11f980f809275677cdfd7ff3c267002872b57 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 00:55:44 +0100 Subject: [PATCH 126/176] rfls --- 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 7337b4945..701cfd0af 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -75,7 +75,7 @@ instance : LT SortOpsCost where instance partialOrderSortOps : PartialOrder SortOpsCost := by apply Function.Injective.partialOrder SortOpsCost.toProd · exact SortOpsCost.toProd.inj' - · simp [SortOpsCost.toProd] + · rfl · intro x y simp only [SortOpsCost.toProd, Function.Embedding.coeFn_mk, Prod.mk_lt_mk, lt_def, le_def] refine ⟨?_, ?_⟩ From e833073b03977ced1c712387188a3725f7d768b3 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 00:56:41 +0100 Subject: [PATCH 127/176] remove some instance names --- 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 701cfd0af..7968bfe20 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -61,7 +61,7 @@ def SortOpsCost.toProd : SortOpsCost ↪ ℕ × ℕ where simp only [mk.injEq, Prod.mk.injEq, imp_self] @[simps, grind] -instance zeroSortOps : Zero SortOpsCost := ⟨0,0⟩ +instance : Zero SortOpsCost := ⟨0,0⟩ @[simps] instance : LE SortOpsCost where From b14e423b2f12d7169f57bb8df0442d61309c8945 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 01:01:11 +0100 Subject: [PATCH 128/176] fix --- Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 542dcee7e..4242caa6f 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -84,13 +84,13 @@ theorem insertOrd_complexity_upper_bound [LinearOrder α] : obtain ⟨ih_compares, ih_inserts⟩ := ih simp only [time, bind_pure_comp, insertOrd, FreeM.lift_def, FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, bind_map_left, - Lean.TimeM.time_bind, AddSortOps_add, List.length_cons, le_def, add_compares, add_inserts] + Lean.TimeM.time_bind, List.length_cons, le_def] split_ifs with h_head · constructor <;> simp_all · constructor - · simp_all only [time, bind_pure_comp, Bool.not_eq_true, Lean.TimeM.time_tick, - cost_cmpLT_compares, FreeM.liftM_bind, FreeM.liftM_liftBind, FreeM.liftM_pure, bind_pure, - Lean.TimeM.time_bind, Lean.TimeM.time_map, AddSortOps_add, add_compares, + · simp_all only [time, Bool.not_eq_true, Lean.TimeM.time_tick, FreeM.liftM_bind, + FreeM.liftM_liftBind, bind_pure_comp, FreeM.liftM_pure, bind_pure, Lean.TimeM.time_bind, + Lean.TimeM.time_map, AddSortOps_add_compares, cost_cmpLT_compares, cost_insertHead_compares, add_zero] grind · simp_all From ec83b8c13b110da1d6daa405ea1ec41a815852c3 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 01:05:21 +0100 Subject: [PATCH 129/176] correctness as a single theorem --- .../Algorithms/ListLinearSearch.lean | 28 ++++++++++++------- .../Models/ListComparisonSearch.lean | 2 +- 2 files changed, 19 insertions(+), 11 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index abf563747..c84fd6698 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -34,8 +34,9 @@ def listLinearSearch (l : List α) (x : α) : Prog (ListSearch α) Bool := do else listLinearSearch ls x +@[grind =] lemma listLinearSearchM_correct_true [DecidableEq α] (l : List α) {x : α} (x_mem_l : x ∈ l) : - (listLinearSearch l x).eval ListSearch_Nat = true := by + (listLinearSearch l x).eval ListSearch.natCost = true := by induction l with | nil => simp_all only [List.not_mem_nil] @@ -45,18 +46,19 @@ lemma listLinearSearchM_correct_true [DecidableEq α] (l : List α) {x : α} (x_ split_ifs with h · obtain (x_head | xtail) := x_mem_l · rw [x_head] at h - simp only [ListSearch_Nat, List.head?_cons, decide_true] at h + simp only [ListSearch.natCost, List.head?_cons, decide_true] at h simp · specialize ih xtail simp · obtain (x_head | x_tail) := x_mem_l · rw [x_head] at h - simp [ListSearch_Nat, List.head?_cons, decide_true] at h + simp [ListSearch.natCost, List.head?_cons, decide_true] at h · specialize ih x_tail simp_all +@[grind =] lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) {x : α} (x_mem_l : x ∉ l) : - (listLinearSearch l x).eval ListSearch_Nat = false := by + (listLinearSearch l x).eval ListSearch.natCost = false := by induction l with | nil => simp_all [listLinearSearch, eval] @@ -66,27 +68,33 @@ lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) {x : α} (x simp only [eval, listLinearSearch, bind, FreeM.lift_def, FreeM.pure_eq_pure, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind] split_ifs with h_eq - · simp only [pure, ListSearch_Nat, List.head?_cons, Option.some.injEq, + · simp only [pure, ListSearch.natCost, List.head?_cons, Option.some.injEq, decide_eq_true_eq] at h_eq grind · assumption +lemma listLinearSearch_correctness [DecidableEq α] (l : List α) (x : α) : + (listLinearSearch l x).eval ListSearch.natCost = l.contains x := by + by_cases hlx : l.contains x + · grind + · grind + lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List α) (x : α) : - (listLinearSearch l x).time ListSearch_Nat ≤ 1 + l.length := by + (listLinearSearch l x).time ListSearch.natCost ≤ 1 + l.length := by induction l with | nil => - simp_all [listLinearSearch, ListSearch_Nat, time] + simp_all [listLinearSearch, ListSearch.natCost, time] | cons head tail ih => - simp_all [listLinearSearch, ListSearch_Nat] + simp_all [listLinearSearch, ListSearch.natCost] split_ifs with h_head · simp · grind lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Nontrivial α] : - ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch_Nat = l.length := by + ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch.natCost = l.length := by obtain ⟨x, y, x_neq_y⟩ := inon use [x,x,x,x,x,y], y - simp_all [ListSearch_Nat, listLinearSearch] + simp_all [ListSearch.natCost, listLinearSearch] end Algorithms diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean index 44f2d41e5..44a16e00c 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean @@ -30,7 +30,7 @@ inductive ListSearch (α : Type) : Type → Type where /-- A model of the `ListSearch` query type that assigns costs to the queries in `ℕ` -/ -def ListSearch_Nat [DecidableEq α] : Model (ListSearch α) ℕ where +def ListSearch.natCost [DecidableEq α] : Model (ListSearch α) ℕ where evalQuery | .compare l x => l.head? = some x cost From f8693554be626d6e1093e68518df9c578bb411fd Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 01:06:22 +0100 Subject: [PATCH 130/176] correctness as a single theorem --- Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index c84fd6698..2b84f3d8f 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -34,7 +34,6 @@ def listLinearSearch (l : List α) (x : α) : Prog (ListSearch α) Bool := do else listLinearSearch ls x -@[grind =] lemma listLinearSearchM_correct_true [DecidableEq α] (l : List α) {x : α} (x_mem_l : x ∈ l) : (listLinearSearch l x).eval ListSearch.natCost = true := by induction l with @@ -56,7 +55,7 @@ lemma listLinearSearchM_correct_true [DecidableEq α] (l : List α) {x : α} (x_ · specialize ih x_tail simp_all -@[grind =] + lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) {x : α} (x_mem_l : x ∉ l) : (listLinearSearch l x).eval ListSearch.natCost = false := by induction l with @@ -76,8 +75,8 @@ lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) {x : α} (x lemma listLinearSearch_correctness [DecidableEq α] (l : List α) (x : α) : (listLinearSearch l x).eval ListSearch.natCost = l.contains x := by by_cases hlx : l.contains x - · grind - · grind + · grind [listLinearSearchM_correct_true] + · grind [listLinearSearchM_correct_false] lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List α) (x : α) : (listLinearSearch l x).time ListSearch.natCost ≤ 1 + l.length := by From 9420e1d5a308e1f579337b15e6d28367fa7b4c87 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 01:07:43 +0100 Subject: [PATCH 131/176] fewer intros in insertOrd --- Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 4242caa6f..b2cb93022 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -35,11 +35,9 @@ def insertOrd (x : α) (l : List α) : Prog (SortOps α) (List α) := do let res ← insertOrd x as insertHead a res -lemma insertOrd_is_ListOrderedInsert [LinearOrder α] : - ∀ (x : α) (l : List α) , - l.Pairwise (· ≤ ·) → - (insertOrd x l).eval (sortModel α) = l.orderedInsert (· ≤ ·) x := by - intro x l h_sorted +lemma insertOrd_is_ListOrderedInsert [LinearOrder α] (x : α) (l : List α) : + l.Pairwise (· ≤ ·) → (insertOrd x l).eval (sortModel α) = l.orderedInsert (· ≤ ·) x := by + intro h_sorted induction l with | nil => simp [insertOrd, sortModel] From b79397328417579952d10098f7ccfa9acab7bfc0 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 01:13:25 +0100 Subject: [PATCH 132/176] Unname instances --- Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean | 4 ++-- Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index b2cb93022..a88a3885a 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -88,8 +88,8 @@ theorem insertOrd_complexity_upper_bound [LinearOrder α] : · constructor · simp_all only [time, Bool.not_eq_true, Lean.TimeM.time_tick, FreeM.liftM_bind, FreeM.liftM_liftBind, bind_pure_comp, FreeM.liftM_pure, bind_pure, Lean.TimeM.time_bind, - Lean.TimeM.time_map, AddSortOps_add_compares, cost_cmpLT_compares, - cost_insertHead_compares, add_zero] + Lean.TimeM.time_map, add_compares, cost_cmpLT_compares, cost_insertHead_compares, + add_zero] grind · simp_all diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 7968bfe20..be2c675e4 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -71,8 +71,8 @@ instance : LE SortOpsCost where instance : LT SortOpsCost where lt soc₁ soc₂ := soc₁ ≤ soc₂ ∧ (soc₁.compares < soc₂.compares ∨ soc₁.inserts < soc₂.inserts) -@[simps!, grind] -instance partialOrderSortOps : PartialOrder SortOpsCost := by +@[grind] +instance : PartialOrder SortOpsCost := by apply Function.Injective.partialOrder SortOpsCost.toProd · exact SortOpsCost.toProd.inj' · rfl @@ -85,11 +85,11 @@ instance partialOrderSortOps : PartialOrder SortOpsCost := by all_goals grind only @[simps] -instance AddSortOps : Add SortOpsCost where +instance : Add SortOpsCost where add (soc₁ soc₂ : SortOpsCost) := ⟨soc₁.compares + soc₂.compares, soc₁.inserts + soc₂.inserts⟩ @[simps] -instance SMulSortOps : SMul ℕ SortOpsCost where +instance : SMul ℕ SortOpsCost where smul (n : ℕ) (soc : SortOpsCost) : SortOpsCost := ⟨n • soc.compares, n • soc.inserts⟩ instance : AddCommMonoid SortOpsCost := by From 971e825455df9f4f5ddfd3c34868cd94c9cdf286 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 01:52:33 +0100 Subject: [PATCH 133/176] Removed (m := Id) in favour of Id.run) --- .../Algorithms/MergeSort.lean | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 09a0556dc..ddefde3a1 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -132,33 +132,33 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : have hleft : (mergeSort left).eval (sortModelNat α) = mergeSortNaive left := by grind have hright : (mergeSort right).eval (sortModelNat α) = mergeSortNaive right := by grind have hleft' : - FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) - (mergeSort (xs.take (xs.length / 2))) = + Id.run (FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) + (mergeSort (xs.take (xs.length / 2)))) = mergeSortNaive (xs.take (xs.length / 2)) := by simpa [left, half, Prog.eval] using hleft have hright' : - FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) - (mergeSort (xs.drop (xs.length / 2))) = + Id.run (FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) + (mergeSort (xs.drop (xs.length / 2)))) = mergeSortNaive (xs.drop (xs.length / 2)) := by simpa [right, half, Prog.eval] using hright have hmerge (a b : List α) : - FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b) = + Id.run (FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b)) = mergeNaive a b := by simpa [Prog.eval] using (merge_is_mergeNaive (α := α) a b) nth_rw 1 [mergeSort, mergeSortNaive] simp only [hlt, if_false, Prog.eval, bind, FreeM.liftM_bind] - set a := FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) + set a := Id.run <| FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) (mergeSort (List.take (xs.length / 2) xs)) with ha - set b := FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) + set b := Id.run <| FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) (mergeSort (List.drop (xs.length / 2) xs)) with hb calc - FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) + Id.run (FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) (merge - (FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) + (Id.run <| FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) (mergeSort (List.take (xs.length / 2) xs))) - (FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) - (mergeSort (List.drop (xs.length / 2) xs)))) = - FreeM.liftM (m := Id) (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b) := by + (Id.run <| FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) + (mergeSort (List.drop (xs.length / 2) xs))))) = + Id.run (FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b)) := by simp [a, b] _ = mergeNaive a b := by apply hmerge a b _ = mergeNaive (mergeSortNaive (List.take (xs.length / 2) xs)) From eca91b33a36185331ce58b2056b06549934c2fda Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 02:05:17 +0100 Subject: [PATCH 134/176] Using Equiv instance for SortOpsCost with Nat pair --- .../Models/ListComparisonSort.lean | 47 +++++++++---------- 1 file changed, 21 insertions(+), 26 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index be2c675e4..eb646a47b 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -41,24 +41,17 @@ structure SortOpsCost where inserts : ℕ /-- -Injective mapping from a pair of ℕ to SortOpsCost +Equivalence between SortOpsCost and ℕ -/ -def SortOpsCost.ofProd : ℕ × ℕ ↪ SortOpsCost where - toFun pair := ⟨pair.1, pair.2⟩ - inj' := by - unfold Function.Injective - intro (_,_) (_, _) - simp only [mk.injEq, Prod.mk.injEq, imp_self] - -/-- -Injective mapping from SortOpsCost to a pair of ℕ --/ -def SortOpsCost.toProd : SortOpsCost ↪ ℕ × ℕ where - toFun pair := (pair.compares, pair.inserts) - inj' := by - unfold Function.Injective - intro ⟨_,_⟩ ⟨_,_⟩ - simp only [mk.injEq, Prod.mk.injEq, imp_self] +def SortOpsCost.Equiv : Equiv SortOpsCost (ℕ × ℕ) where + toFun sortOps := (sortOps.compares, sortOps.inserts) + invFun pair := ⟨pair.1, pair.2⟩ + left_inv := by + intro _ + rfl + right_inv := by + intro _ + rfl @[simps, grind] instance : Zero SortOpsCost := ⟨0,0⟩ @@ -73,16 +66,18 @@ instance : LT SortOpsCost where @[grind] instance : PartialOrder SortOpsCost := by - apply Function.Injective.partialOrder SortOpsCost.toProd - · exact SortOpsCost.toProd.inj' + apply Function.Injective.partialOrder SortOpsCost.Equiv.toEmbedding + · exact SortOpsCost.Equiv.toEmbedding.inj' · rfl · intro x y - simp only [SortOpsCost.toProd, Function.Embedding.coeFn_mk, Prod.mk_lt_mk, lt_def, le_def] + simp only [lt_def, le_def] refine ⟨?_, ?_⟩ - · rintro (⟨h_compares, h_inserts⟩ | ⟨h_compares, h_inserts⟩) - all_goals grind only - · rintro ⟨h_leq, (h | h)⟩ - all_goals grind only + · simp only [SortOpsCost.Equiv, Equiv.coe_toEmbedding, Equiv.coe_fn_mk, Prod.mk_lt_mk] + rintro (⟨_, _⟩ | ⟨_, _⟩) + all_goals grind + · simp only [SortOpsCost.Equiv, Equiv.coe_toEmbedding, Equiv.coe_fn_mk, Prod.mk_lt_mk, and_imp] + intros + all_goals grind @[simps] instance : Add SortOpsCost where @@ -93,8 +88,8 @@ instance : SMul ℕ SortOpsCost where smul (n : ℕ) (soc : SortOpsCost) : SortOpsCost := ⟨n • soc.compares, n • soc.inserts⟩ instance : AddCommMonoid SortOpsCost := by - apply Function.Injective.addCommMonoid SortOpsCost.toProd - · exact SortOpsCost.toProd.inj' + apply Function.Injective.addCommMonoid SortOpsCost.Equiv.toEmbedding + · exact SortOpsCost.Equiv.toEmbedding.inj' · rfl · intro ⟨xcomp, xins⟩ ⟨ycomp, yins⟩ rfl From d67d698677af572fcf96114ddfe3c8e200fe5fa9 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 02:14:53 +0100 Subject: [PATCH 135/176] Simplify Prog.bind_pure and Prog.pure_bind --- Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean | 3 ++- Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean | 6 +++--- Cslib/AlgorithmsTheory/QueryModel.lean | 9 ++++----- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index 2b84f3d8f..c12b00f57 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -41,7 +41,8 @@ lemma listLinearSearchM_correct_true [DecidableEq α] (l : List α) {x : α} (x_ simp_all only [List.not_mem_nil] | cons head tail ih => simp_all only [eval, List.mem_cons, listLinearSearch, FreeM.lift_def, FreeM.pure_eq_pure, - FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, pure_bind] + FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, + LawfulMonad.pure_bind] split_ifs with h · obtain (x_head | xtail) := x_mem_l · rw [x_head] at h diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index a88a3885a..130bf64e7 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -87,9 +87,9 @@ theorem insertOrd_complexity_upper_bound [LinearOrder α] : · constructor <;> simp_all · constructor · simp_all only [time, Bool.not_eq_true, Lean.TimeM.time_tick, FreeM.liftM_bind, - FreeM.liftM_liftBind, bind_pure_comp, FreeM.liftM_pure, bind_pure, Lean.TimeM.time_bind, - Lean.TimeM.time_map, add_compares, cost_cmpLT_compares, cost_insertHead_compares, - add_zero] + FreeM.liftM_liftBind, bind_pure_comp, FreeM.liftM_pure, _root_.bind_pure, + Lean.TimeM.time_bind, Lean.TimeM.time_map, add_compares, cost_cmpLT_compares, + cost_insertHead_compares, add_zero] grind · simp_all diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index e4cd4127a..9e04f325c 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -91,14 +91,13 @@ def Prog.time [AddCommMonoid Cost] (P.liftM M.timeQuery).time @[grind =] -lemma Prog.time.bind_pure [AddCommMonoid Cost] (M : Model Q Cost) : - Prog.time (op >>= FreeM.pure) M = (Prog.time op M) := by +lemma Prog.bind_pure : + op >>= FreeM.pure = op := by simp only [bind, FreeM.bind_pure] @[grind =] -lemma Prog.time.pure_bind - [AddCommMonoid Cost] (M : Model Q Cost) : - Prog.time (FreeM.pure x >>= m) M = (m x).time M := by +lemma Prog.pure_bind : + FreeM.pure x >>= m = m x := by rfl @[grind =] From fa6980f6b34d2ea2d80c544c5f1f09a86145154e Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 02:24:02 +0100 Subject: [PATCH 136/176] BEq can be better that decidableEq for equality --- Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean | 7 +++---- Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean | 4 ++-- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index c12b00f57..b1b528049 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -46,13 +46,13 @@ lemma listLinearSearchM_correct_true [DecidableEq α] (l : List α) {x : α} (x_ split_ifs with h · obtain (x_head | xtail) := x_mem_l · rw [x_head] at h - simp only [ListSearch.natCost, List.head?_cons, decide_true] at h + simp only [ListSearch.natCost, List.head?_cons] at h simp · specialize ih xtail simp · obtain (x_head | x_tail) := x_mem_l · rw [x_head] at h - simp [ListSearch.natCost, List.head?_cons, decide_true] at h + simp [ListSearch.natCost, List.head?_cons] at h · specialize ih x_tail simp_all @@ -68,8 +68,7 @@ lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) {x : α} (x simp only [eval, listLinearSearch, bind, FreeM.lift_def, FreeM.pure_eq_pure, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind] split_ifs with h_eq - · simp only [pure, ListSearch.natCost, List.head?_cons, Option.some.injEq, - decide_eq_true_eq] at h_eq + · simp only [pure, ListSearch.natCost, List.head?_cons] at h_eq grind · assumption diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean index 44a16e00c..4352c5392 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean @@ -30,9 +30,9 @@ inductive ListSearch (α : Type) : Type → Type where /-- A model of the `ListSearch` query type that assigns costs to the queries in `ℕ` -/ -def ListSearch.natCost [DecidableEq α] : Model (ListSearch α) ℕ where +def ListSearch.natCost [BEq α] : Model (ListSearch α) ℕ where evalQuery - | .compare l x => l.head? = some x + | .compare l x => l.head? == some x cost | .compare _ _ => 1 From d1faebb2767d504a9e0a2aae77ab6d5a11101886 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 02:24:37 +0100 Subject: [PATCH 137/176] BEq can be better that decidableEq for equality --- Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean | 1 - 1 file changed, 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index b1b528049..2db28f410 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -56,7 +56,6 @@ lemma listLinearSearchM_correct_true [DecidableEq α] (l : List α) {x : α} (x_ · specialize ih x_tail simp_all - lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) {x : α} (x_mem_l : x ∉ l) : (listLinearSearch l x).eval ListSearch.natCost = false := by induction l with From 786dbb33ef47fdd722b812602a85361304873c48 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 02:44:43 +0100 Subject: [PATCH 138/176] simps --- .../Algorithms/ListInsertionSort.lean | 2 +- .../Algorithms/ListOrderedInsert.lean | 8 ++--- .../Algorithms/MergeSort.lean | 5 ++- .../Models/ListComparisonSort.lean | 32 ++----------------- 4 files changed, 11 insertions(+), 36 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index 13b2f0d1c..5aa291653 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -64,7 +64,7 @@ lemma insertionSort_length [LinearOrder α] (l : List α) : simp [insertionSort] | cons head tail ih => have h := insertOrd_length (x := head) ((insertionSort tail).eval (sortModel α)) - simp only [eval] at ih + simp only [eval, sortModel_evalQuery] at ih simpa [insertionSort, ih] using h theorem insertionSort_complexity [LinearOrder α] (l : List α) : diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 130bf64e7..f6b934662 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -86,10 +86,10 @@ theorem insertOrd_complexity_upper_bound [LinearOrder α] : split_ifs with h_head · constructor <;> simp_all · constructor - · simp_all only [time, Bool.not_eq_true, Lean.TimeM.time_tick, FreeM.liftM_bind, - FreeM.liftM_liftBind, bind_pure_comp, FreeM.liftM_pure, _root_.bind_pure, - Lean.TimeM.time_bind, Lean.TimeM.time_map, add_compares, cost_cmpLT_compares, - cost_insertHead_compares, add_zero] + · simp_all only [time, sortModel_evalQuery, decide_eq_true_eq, not_le, sortModel_cost, + Lean.TimeM.time_tick, FreeM.liftM_bind, FreeM.liftM_liftBind, bind_pure_comp, + FreeM.liftM_pure, _root_.bind_pure, Lean.TimeM.time_bind, Lean.TimeM.time_map, + add_compares, add_zero] grind · simp_all diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index ddefde3a1..601394681 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -77,7 +77,10 @@ lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : · expose_names simp_all [Prog.eval, merge, rest, sortModelNat] · expose_names - simp_all [Prog.eval, merge, rest] + simp_all only [not_le, Prog.eval, merge, FreeM.lift_def, FreeM.pure_eq_pure, FreeM.bind_eq_bind, + FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, sortModelNat_eval_false, + pure_bind, Bool.false_eq_true, ↓reduceIte, FreeM.liftM_bind, FreeM.liftM_pure, bind_pure_comp, + Id.run_map, rest] lemma merge_length [LinearOrder α] (x y : List α) : ((merge x y).eval (sortModelNat α)).length = x.length + y.length := by diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index eb646a47b..62a8b434d 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -99,6 +99,7 @@ instance : AddCommMonoid SortOpsCost := by /-- A model of `SortOps` that uses `SortOpsCost` as the cost type for operations. -/ +@[simps, grind] def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where evalQuery | .cmpLE x y => decide (x ≤ y) @@ -107,35 +108,6 @@ def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost wher | .cmpLE _ _ => ⟨1,0⟩ | .insertHead _ _ => ⟨0,1⟩ -@[grind =] -lemma SortModel_cmpquery_iff [LinearOrder α] (x y : α) : - (sortModel α).evalQuery (cmpLE x y) ↔ x ≤ y := by - simp [sortModel] - -@[grind =] -lemma SortModel_insertHeadquery_iff [LinearOrder α] (l : List α) (x : α) : - (sortModel α).evalQuery (insertHead x l) = x :: l := by - simp [sortModel] - -@[simp] -lemma cost_cmpLT_compares [LinearOrder α] : ((sortModel α).2 (cmpLE head x)).compares = 1 := by - simp [sortModel] - -@[simp] -lemma cost_cmpLT_inserts [LinearOrder α] : - ((sortModel α).2 (cmpLE head x)).inserts = 0 := by - simp [sortModel] - -@[simp] -lemma cost_insertHead_compares [LinearOrder α] : - ((sortModel α).2 (insertHead x l)).compares = 0 := by - simp [sortModel] - -@[simp] -lemma cost_insertHead_inserts [LinearOrder α] : - ((sortModel α).2 (insertHead x l)).inserts = 1 := by - simp [sortModel] - end SortOpsCostModel section NatModel @@ -153,7 +125,7 @@ def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where | .insertHead _ _ => 1 @[simp] -lemma sortModelNat_eval_1 [LinearOrder α] (y x : α) : +lemma sortModelNat_eval_false [LinearOrder α] (y x : α) : y < x → (sortModelNat α).evalQuery (cmpLE x y) = false := by intro h simp only [sortModelNat, decide_eq_false_iff_not, not_le] From 193f4e8c0a4c5e728d7bb2d4264f72baf8675332 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 03:38:38 +0100 Subject: [PATCH 139/176] simps --- Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index 2db28f410..fc538255e 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -34,7 +34,7 @@ def listLinearSearch (l : List α) (x : α) : Prog (ListSearch α) Bool := do else listLinearSearch ls x -lemma listLinearSearchM_correct_true [DecidableEq α] (l : List α) {x : α} (x_mem_l : x ∈ l) : +lemma listLinearSearchM_correct_true [BEq α] [LawfulBEq α] (l : List α) {x : α} (x_mem_l : x ∈ l) : (listLinearSearch l x).eval ListSearch.natCost = true := by induction l with | nil => @@ -51,12 +51,11 @@ lemma listLinearSearchM_correct_true [DecidableEq α] (l : List α) {x : α} (x_ · specialize ih xtail simp · obtain (x_head | x_tail) := x_mem_l - · rw [x_head] at h - simp [ListSearch.natCost, List.head?_cons] at h + · simp [x_head, ListSearch.natCost] at h · specialize ih x_tail simp_all -lemma listLinearSearchM_correct_false [DecidableEq α] (l : List α) {x : α} (x_mem_l : x ∉ l) : +lemma listLinearSearchM_correct_false [BEq α] [LawfulBEq α] (l : List α) {x : α} (x_mem_l : x ∉ l) : (listLinearSearch l x).eval ListSearch.natCost = false := by induction l with | nil => @@ -77,7 +76,7 @@ lemma listLinearSearch_correctness [DecidableEq α] (l : List α) (x : α) : · grind [listLinearSearchM_correct_true] · grind [listLinearSearchM_correct_false] -lemma listLinearSearchM_time_complexity_upper_bound [DecidableEq α] (l : List α) (x : α) : +lemma listLinearSearchM_time_complexity_upper_bound [BEq α] (l : List α) (x : α) : (listLinearSearch l x).time ListSearch.natCost ≤ 1 + l.length := by induction l with | nil => From 66d24fa9359f7610dc04ead5d7c52ba28995dba0 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 03:40:04 +0100 Subject: [PATCH 140/176] simps --- Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean | 1 - 1 file changed, 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index fc538255e..4374341a6 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -19,7 +19,6 @@ namespace Algorithms open Prog - open ListSearch in /-- Linear Search in Lists on top of the `ListSearch` query model. From 77646e8a1a57ec7c48ac83b4f0c59eba6094ee99 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 04:18:33 +0100 Subject: [PATCH 141/176] Remove mergeNaive --- .../Algorithms/MergeSort.lean | 141 +++--------------- 1 file changed, 23 insertions(+), 118 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 601394681..6444180d8 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -8,34 +8,13 @@ module public import Cslib.AlgorithmsTheory.QueryModel public import Cslib.AlgorithmsTheory.Models.ListComparisonSort - +import all Init.Data.List.Sort.Basic @[expose] public section namespace Cslib.Algorithms open SortOps - -/-- -The vanilla-lean version of `merge` that merges two lists. When the two lists -are sorted, so is the merged list. --/ -def mergeNaive [LinearOrder α] (x y : List α) : List α := - match x,y with - | [], ys => ys - | xs, [] => xs - | x :: xs', y :: ys' => - if x ≤ y then - let rest := mergeNaive xs' (y :: ys') - x :: rest - else - let rest := mergeNaive (x :: xs') ys' - y :: rest - -lemma mergeNaive_length [LinearOrder α] (x y : List α) : - (mergeNaive x y).length = x.length + y.length := by - fun_induction mergeNaive <;> try grind - /-- Merge two sorted lists using comparisons in the query monad. -/ @[simp] def merge (x y : List α) : Prog (SortOps α) (List α) := do @@ -69,23 +48,23 @@ lemma merge_timeComplexity [LinearOrder α] (x y : List α) : simpa [sortModelNat, Lean.TimeM.pure, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using (Nat.add_le_add_left ih1 1) -lemma merge_is_mergeNaive [LinearOrder α] (x y : List α) : - (merge x y).eval (sortModelNat α) = mergeNaive x y := by - fun_induction mergeNaive +lemma merge_eval_eq_list_merge [LinearOrder α] (x y : List α) : + (merge x y).eval (sortModelNat α) = List.merge x y := by + fun_induction List.merge · simp [merge] · simp [merge] · expose_names - simp_all [Prog.eval, merge, rest, sortModelNat] + simp_all [Prog.eval, merge, sortModelNat] · expose_names - simp_all only [not_le, Prog.eval, merge, FreeM.lift_def, FreeM.pure_eq_pure, FreeM.bind_eq_bind, - FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, sortModelNat_eval_false, - pure_bind, Bool.false_eq_true, ↓reduceIte, FreeM.liftM_bind, FreeM.liftM_pure, bind_pure_comp, - Id.run_map, rest] + simp_all only [decide_eq_true_eq, not_le, Prog.eval, merge, FreeM.lift_def, FreeM.pure_eq_pure, + FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, + sortModelNat_eval_false, pure_bind, Bool.false_eq_true, ↓reduceIte, FreeM.liftM_bind, + FreeM.liftM_pure, bind_pure_comp, Id.run_map] lemma merge_length [LinearOrder α] (x y : List α) : ((merge x y).eval (sortModelNat α)).length = x.length + y.length := by - rw [merge_is_mergeNaive] - apply mergeNaive_length + rw [merge_eval_eq_list_merge] + apply List.length_merge /-- The `mergeSort` algorithm in the `SortOps` query model. It sorts the input list @@ -109,7 +88,7 @@ def mergeSortNaive [LinearOrder α] (xs : List α) : List α := else let sortedLeft := mergeSortNaive (xs.take (xs.length/2)) let sortedRight := mergeSortNaive (xs.drop (xs.length/2)) - mergeNaive sortedLeft sortedRight + List.merge sortedLeft sortedRight lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : (mergeSort xs).eval (sortModelNat α) = mergeSortNaive xs := by @@ -146,8 +125,8 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : simpa [right, half, Prog.eval] using hright have hmerge (a b : List α) : Id.run (FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b)) = - mergeNaive a b := by - simpa [Prog.eval] using (merge_is_mergeNaive (α := α) a b) + List.merge a b := by + simpa [Prog.eval] using (merge_eval_eq_list_merge (α := α) a b) nth_rw 1 [mergeSort, mergeSortNaive] simp only [hlt, if_false, Prog.eval, bind, FreeM.liftM_bind] set a := Id.run <| FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) @@ -163,10 +142,11 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : (mergeSort (List.drop (xs.length / 2) xs))))) = Id.run (FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b)) := by simp [a, b] - _ = mergeNaive a b := by apply hmerge a b - _ = mergeNaive (mergeSortNaive (List.take (xs.length / 2) xs)) + _ = List.merge a b := by apply hmerge a b + _ = List.merge (mergeSortNaive (List.take (xs.length / 2) xs)) (mergeSortNaive (List.drop (xs.length / 2) xs)) := by - simp only [a, b, hleft', hright'] + simp only [hleft', hright', a, b] + rfl exact hP xs rfl lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : @@ -194,7 +174,7 @@ lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : (ys.drop (ys.length / 2)).length := by grind have hdiv_le : ys.length / 2 ≤ ys.length := Nat.div_le_self _ _ rw [mergeSortNaive] - simp [hlt, mergeNaive_length, hleft, hright, List.length_take, List.length_drop, + simp [hlt, List.length_merge, hleft, hright, List.length_take, List.length_drop, Nat.min_eq_left hdiv_le, Nat.add_sub_of_le hdiv_le] exact hP xs rfl @@ -203,85 +183,11 @@ lemma mergeSort_length [LinearOrder α] (xs : List α) : rw [mergeSort_is_mergeSortNaive] apply mergeSortNaive_length - -lemma mergeNaive_mem [LinearOrder α] (xs ys : List α) : - x ∈ mergeNaive xs ys → x ∈ xs ∨ x ∈ ys := by - fun_induction mergeNaive - · simp - · simp - · expose_names - intro h - simp only [List.mem_cons] at h - obtain h | h := h - · simp [h] - · simp only [rest] at h - specialize ih1 h - obtain ih | ih := ih1 - · simp only [List.mem_cons] - tauto - · simp [ih] - · expose_names - intro h - simp only [List.mem_cons, rest] at h - obtain h | h := h - · simp only [List.mem_cons] - tauto - · specialize ih1 h - tauto - -lemma mergeNaive_sorted_sorted [LinearOrder α] (xs ys : List α) - (hxs_mono : xs.Pairwise (· ≤ ·)) (hys_mono : ys.Pairwise (· ≤ ·)) : - (mergeNaive xs ys).Pairwise (· ≤ ·) := by - induction xs generalizing ys with - | nil => - simp_all [mergeNaive] - | cons xhead xtail x_ih => - induction ys with - | nil => - simp_all [mergeNaive] - | cons yhead ytail y_ih => - simp only [mergeNaive] - by_cases hxy : xhead ≤ yhead - · simp only [hxy, ↓reduceIte, List.pairwise_cons] - refine ⟨?_, ?_⟩ - · intro a a_mem - apply mergeNaive_mem at a_mem - simp_all only [List.pairwise_cons, List.mem_cons, forall_const] - obtain ⟨left, right⟩ := hxs_mono - obtain ⟨left_1, right_1⟩ := hys_mono - cases a_mem with - | inl h => simp_all only - | inr h_1 => - cases h_1 with - | inl h => - subst h - grind - | inr h_2 => grind - · simp_all - · simp only [hxy, ↓reduceIte, List.pairwise_cons] - refine ⟨?_, ?_⟩ - · intro a a_mem - apply mergeNaive_mem at a_mem - simp_all only [List.pairwise_cons, not_le, List.mem_cons, forall_const] - obtain ⟨left, right⟩ := hxs_mono - obtain ⟨left_1, right_1⟩ := hys_mono - cases a_mem with - | inl h => - cases h with - | inl h_1 => - subst h_1 - grind - | inr h_2 => grind - | inr h_1 => simp_all only - · simp_all - - lemma merge_sorted_sorted [LinearOrder α] (xs ys : List α) (hxs_mono : xs.Pairwise (· ≤ ·)) (hys_mono : ys.Pairwise (· ≤ ·)) : ((merge xs ys).eval (sortModelNat α)).Pairwise (· ≤ ·) := by - rw [merge_is_mergeNaive] - apply mergeNaive_sorted_sorted - all_goals assumption + rw [merge_eval_eq_list_merge] + grind [List.pairwise_merge] lemma mergeSortNaive_sorted [LinearOrder α] (xs : List α) : (mergeSortNaive xs).Pairwise (· ≤ ·) := by @@ -312,9 +218,8 @@ lemma mergeSortNaive_sorted [LinearOrder α] (xs : List α) : have hleft : (mergeSortNaive (ys.take (ys.length / 2))).Pairwise (· ≤ ·) := by grind have hright : (mergeSortNaive (ys.drop (ys.length / 2))).Pairwise (· ≤ ·) := by grind rw [mergeSortNaive] - simpa [hlt] using mergeNaive_sorted_sorted - (mergeSortNaive (ys.take (ys.length / 2))) - (mergeSortNaive (ys.drop (ys.length / 2))) hleft hright + simp only [hlt, ↓reduceIte] + grind [List.pairwise_merge] exact hP xs rfl theorem mergeSort_sorted [LinearOrder α] (xs : List α) : From 16e08b38d867b9c14ca4db664a75363504cf3d7c Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 04:24:09 +0100 Subject: [PATCH 142/176] Fix instruction docs --- Cslib/AlgorithmsTheory/QueryModel.lean | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 9e04f325c..345ad5951 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -31,16 +31,17 @@ parametric type of query operations. 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 which carries. This type must at least one index parameter - which denotes 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 +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 `Model Q C` type instance +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 +## Tags query model, free monad, time complexity, Prog -/ From b70c432b43baf8a2d4b9049be97750d502f2713d Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 04:26:20 +0100 Subject: [PATCH 143/176] made mergeSortNaive private --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 6444180d8..172e39a0c 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -83,14 +83,14 @@ def mergeSort (xs : List α) : Prog (SortOps α) (List α) := do /-- The vanilla-lean version of `mergeSortNaive` that is extensionally equal to `mergeSort` -/ -def mergeSortNaive [LinearOrder α] (xs : List α) : List α := +private def mergeSortNaive [LinearOrder α] (xs : List α) : List α := if xs.length < 2 then xs else let sortedLeft := mergeSortNaive (xs.take (xs.length/2)) let sortedRight := mergeSortNaive (xs.drop (xs.length/2)) List.merge sortedLeft sortedRight -lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : +private lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : (mergeSort xs).eval (sortModelNat α) = mergeSortNaive xs := by classical let P : Nat → Prop := @@ -149,7 +149,7 @@ lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : rfl exact hP xs rfl -lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : +private lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : (mergeSortNaive xs).length = xs.length := by let P : Nat → Prop := fun n => ∀ ys : List α, ys.length = n → (mergeSortNaive ys).length = ys.length @@ -189,7 +189,7 @@ lemma merge_sorted_sorted [LinearOrder α] (xs ys : List α) rw [merge_eval_eq_list_merge] grind [List.pairwise_merge] -lemma mergeSortNaive_sorted [LinearOrder α] (xs : List α) : +private lemma mergeSortNaive_sorted [LinearOrder α] (xs : List α) : (mergeSortNaive xs).Pairwise (· ≤ ·) := by let P : Nat → Prop := fun n => ∀ ys : List α, ys.length = n → (mergeSortNaive ys).Pairwise (· ≤ ·) From 0f93390cd7e00f415e4f2dd946c4505291bbfc16 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 04:27:13 +0100 Subject: [PATCH 144/176] fix doc typo --- Cslib/AlgorithmsTheory/QueryModel.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 345ad5951..89eb7420f 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -34,7 +34,7 @@ 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. + 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 From 22e6bfa5dd5ade8e28df6157ab5d9dd037fe99b9 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 04:28:28 +0100 Subject: [PATCH 145/176] naming --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 172e39a0c..e13820002 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -48,7 +48,7 @@ lemma merge_timeComplexity [LinearOrder α] (x y : List α) : simpa [sortModelNat, Lean.TimeM.pure, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using (Nat.add_le_add_left ih1 1) -lemma merge_eval_eq_list_merge [LinearOrder α] (x y : List α) : +lemma merge_eval_eq_listMerge [LinearOrder α] (x y : List α) : (merge x y).eval (sortModelNat α) = List.merge x y := by fun_induction List.merge · simp [merge] @@ -63,7 +63,7 @@ lemma merge_eval_eq_list_merge [LinearOrder α] (x y : List α) : lemma merge_length [LinearOrder α] (x y : List α) : ((merge x y).eval (sortModelNat α)).length = x.length + y.length := by - rw [merge_eval_eq_list_merge] + rw [merge_eval_eq_listMerge] apply List.length_merge /-- @@ -126,7 +126,7 @@ private lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : have hmerge (a b : List α) : Id.run (FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b)) = List.merge a b := by - simpa [Prog.eval] using (merge_eval_eq_list_merge (α := α) a b) + simpa [Prog.eval] using (merge_eval_eq_listMerge (α := α) a b) nth_rw 1 [mergeSort, mergeSortNaive] simp only [hlt, if_false, Prog.eval, bind, FreeM.liftM_bind] set a := Id.run <| FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) @@ -186,7 +186,7 @@ lemma mergeSort_length [LinearOrder α] (xs : List α) : lemma merge_sorted_sorted [LinearOrder α] (xs ys : List α) (hxs_mono : xs.Pairwise (· ≤ ·)) (hys_mono : ys.Pairwise (· ≤ ·)) : ((merge xs ys).eval (sortModelNat α)).Pairwise (· ≤ ·) := by - rw [merge_eval_eq_list_merge] + rw [merge_eval_eq_listMerge] grind [List.pairwise_merge] private lemma mergeSortNaive_sorted [LinearOrder α] (xs : List α) : From 7a4a6a4bb26824e3c80a74bc4f94f63ccfb4fe18 Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Tue, 24 Feb 2026 18:11:52 +0000 Subject: [PATCH 146/176] Fix induction proofs and add missing pures --- .../Algorithms/MergeSort.lean | 207 ++++++++---------- 1 file changed, 96 insertions(+), 111 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index e13820002..05ebf598b 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -93,90 +93,80 @@ private def mergeSortNaive [LinearOrder α] (xs : List α) : List α := private lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : (mergeSort xs).eval (sortModelNat α) = mergeSortNaive xs := by classical - let P : Nat → Prop := - fun n => ∀ xs, xs.length = n → (mergeSort xs).eval (sortModelNat α) = mergeSortNaive xs - have hP : P xs.length := by - induction hlen : xs.length using Nat.strong_induction_on generalizing xs with - | h n ih => - intro xs hlen - by_cases hlt : xs.length < 2 - · nth_rw 1 [mergeSort, mergeSortNaive] - simp [hlt, Prog.eval] - · have hge : 2 ≤ xs.length := by grind - have hpos : 0 < xs.length := by grind - set half : Nat := xs.length / 2 - set left : List α := xs.take half - set right : List α := xs.drop half - have hhalf_lt : half < xs.length := by grind - have hleft_le : left.length ≤ half := by grind - have hleft_lt_len : left.length < xs.length := by grind - have hright_lt_len : right.length < xs.length := by grind - have hleft : (mergeSort left).eval (sortModelNat α) = mergeSortNaive left := by grind - have hright : (mergeSort right).eval (sortModelNat α) = mergeSortNaive right := by grind - have hleft' : - Id.run (FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) - (mergeSort (xs.take (xs.length / 2)))) = - mergeSortNaive (xs.take (xs.length / 2)) := by - simpa [left, half, Prog.eval] using hleft - have hright' : - Id.run (FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) - (mergeSort (xs.drop (xs.length / 2)))) = - mergeSortNaive (xs.drop (xs.length / 2)) := by - simpa [right, half, Prog.eval] using hright - have hmerge (a b : List α) : - Id.run (FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b)) = - List.merge a b := by - simpa [Prog.eval] using (merge_eval_eq_listMerge (α := α) a b) - nth_rw 1 [mergeSort, mergeSortNaive] - simp only [hlt, if_false, Prog.eval, bind, FreeM.liftM_bind] - set a := Id.run <| FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) - (mergeSort (List.take (xs.length / 2) xs)) with ha - set b := Id.run <| FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) - (mergeSort (List.drop (xs.length / 2) xs)) with hb - calc - Id.run (FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) - (merge - (Id.run <| FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) - (mergeSort (List.take (xs.length / 2) xs))) - (Id.run <| FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) - (mergeSort (List.drop (xs.length / 2) xs))))) = - Id.run (FreeM.liftM (fun {ι} q => (sortModelNat α).evalQuery q) (merge a b)) := by - simp [a, b] - _ = List.merge a b := by apply hmerge a b - _ = List.merge (mergeSortNaive (List.take (xs.length / 2) xs)) - (mergeSortNaive (List.drop (xs.length / 2) xs)) := by - simp only [hleft', hright', a, b] - rfl - exact hP xs rfl + induction hlen : xs.length using Nat.strong_induction_on generalizing xs with | _ n ih + by_cases hlt : xs.length < 2 + · nth_rw 1 [mergeSort, mergeSortNaive] + simp [hlt, Prog.eval] + · have hge : 2 ≤ xs.length := by grind + have hpos : 0 < xs.length := by grind + set half : Nat := xs.length / 2 + set left : List α := xs.take half + set right : List α := xs.drop half + have hhalf_lt : half < xs.length := by grind + have hleft_le : left.length ≤ half := by grind + have hleft_lt_len : left.length < xs.length := by grind + have hright_lt_len : right.length < xs.length := by grind + have hleft : (mergeSort left).eval (sortModelNat α) = mergeSortNaive left := by grind + have hright : (mergeSort right).eval (sortModelNat α) = mergeSortNaive right := by grind + have hleft' : + Id.run (FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) + (mergeSort (xs.take (xs.length / 2)))) = + mergeSortNaive (xs.take (xs.length / 2)) := by + simpa [left, half, Prog.eval] using hleft + have hright' : + Id.run (FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) + (mergeSort (xs.drop (xs.length / 2)))) = + mergeSortNaive (xs.drop (xs.length / 2)) := by + simpa [right, half, Prog.eval] using hright + have hmerge (a b : List α) : + Id.run (FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) (merge a b)) = + List.merge a b := by + simpa [Prog.eval] using (merge_eval_eq_listMerge (α := α) a b) + nth_rw 1 [mergeSort, mergeSortNaive] + simp only [hlt, if_false, Prog.eval, bind, FreeM.liftM_bind] + set a := Id.run <| FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) + (mergeSort (List.take (xs.length / 2) xs)) with ha + set b := Id.run <| FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) + (mergeSort (List.drop (xs.length / 2) xs)) with hb + calc + Id.run (FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) + (merge + (Id.run <| FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) + (mergeSort (List.take (xs.length / 2) xs))) + (Id.run <| FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) + (mergeSort (List.drop (xs.length / 2) xs))))) = + Id.run (FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) (merge a b)) := by + simp [a, b] + _ = List.merge a b := by apply hmerge a b + _ = List.merge (mergeSortNaive (List.take (xs.length / 2) xs)) + (mergeSortNaive (List.drop (xs.length / 2) xs)) := by + simp only [hleft', hright', a, b] + rfl private lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : (mergeSortNaive xs).length = xs.length := by - let P : Nat → Prop := - fun n => ∀ ys : List α, ys.length = n → (mergeSortNaive ys).length = ys.length - have hP : P xs.length := by - induction hlen : xs.length using Nat.strong_induction_on generalizing xs with - | h n ih => - intro ys hlen - by_cases hlt : ys.length < 2 - · simp [mergeSortNaive, hlt] - · have hge : 2 ≤ ys.length := le_of_not_gt hlt - have hpos : 0 < ys.length := lt_of_lt_of_le (by decide : 0 < (2 : Nat)) hge - have hhalf_lt : ys.length / 2 < ys.length := by grind - have htake_lt : (ys.take (ys.length / 2)).length < ys.length := by - simp only [List.length_take, inf_lt_right, not_le] - grind - have hdrop_lt : (ys.drop (ys.length / 2)).length < ys.length := by - simp only [List.length_drop, tsub_lt_self_iff, Nat.div_pos_iff, Nat.zero_lt_succ, true_and] - grind - have hleft : (mergeSortNaive (ys.take (ys.length / 2))).length = - (ys.take (ys.length / 2)).length := by grind - have hright : (mergeSortNaive (ys.drop (ys.length / 2))).length = - (ys.drop (ys.length / 2)).length := by grind - have hdiv_le : ys.length / 2 ≤ ys.length := Nat.div_le_self _ _ - rw [mergeSortNaive] - simp [hlt, List.length_merge, hleft, hright, List.length_take, List.length_drop, - Nat.min_eq_left hdiv_le, Nat.add_sub_of_le hdiv_le] - exact hP xs rfl + induction hlen : xs.length using Nat.strong_induction_on generalizing xs with | _ n ih + cases hlen + by_cases hlt : xs.length < 2 + · simp [mergeSortNaive, hlt] + · have hge : 2 ≤ xs.length := le_of_not_gt hlt + have hpos : 0 < xs.length := lt_of_lt_of_le (by decide : 0 < (2 : Nat)) hge + have hhalf_lt : xs.length / 2 < xs.length := by grind + have htake_lt : (xs.take (xs.length / 2)).length < xs.length := by + simp only [List.length_take, inf_lt_right, not_le] + grind + have hdrop_lt : (xs.drop (xs.length / 2)).length < xs.length := by + simp only [List.length_drop, tsub_lt_self_iff, Nat.div_pos_iff, Nat.zero_lt_succ, true_and] + grind + have hleft : (mergeSortNaive (xs.take (xs.length / 2))).length = + (xs.take (xs.length / 2)).length := by grind + have hright : (mergeSortNaive (xs.drop (xs.length / 2))).length = + (xs.drop (xs.length / 2)).length := by grind + have hdiv_le : xs.length / 2 ≤ xs.length := Nat.div_le_self _ _ + rw [mergeSortNaive] + simp [hlt, List.length_merge, hleft, hright, List.length_take, List.length_drop, + Nat.min_eq_left hdiv_le, Nat.add_sub_of_le hdiv_le] + lemma mergeSort_length [LinearOrder α] (xs : List α) : ((mergeSort xs).eval (sortModelNat α)).length = xs.length := by @@ -191,36 +181,31 @@ lemma merge_sorted_sorted [LinearOrder α] (xs ys : List α) private lemma mergeSortNaive_sorted [LinearOrder α] (xs : List α) : (mergeSortNaive xs).Pairwise (· ≤ ·) := by - let P : Nat → Prop := - fun n => ∀ ys : List α, ys.length = n → (mergeSortNaive ys).Pairwise (· ≤ ·) - have hP : P xs.length := by - refine Nat.strong_induction_on (n := xs.length) ?_ - intro n ih ys hlen - by_cases hlt : ys.length < 2 - · cases ys with - | nil => - simp [mergeSortNaive] - | cons y ys' => - cases ys' with - | nil => - simp [mergeSortNaive] - | cons z zs => - exact (Nat.not_lt_of_ge (by simp) hlt).elim - · have hge : 2 ≤ ys.length := le_of_not_gt hlt - have hpos : 0 < ys.length := lt_of_lt_of_le (by decide : 0 < (2 : Nat)) hge - have hhalf_lt : ys.length / 2 < ys.length := by grind - have htake_lt : (ys.take (ys.length / 2)).length < ys.length := by - simp only [List.length_take, inf_lt_right, not_le] - grind - have hdrop_lt : (ys.drop (ys.length / 2)).length < ys.length := by - simp only [List.length_drop, tsub_lt_self_iff, Nat.div_pos_iff, Nat.zero_lt_succ, true_and] - grind - have hleft : (mergeSortNaive (ys.take (ys.length / 2))).Pairwise (· ≤ ·) := by grind - have hright : (mergeSortNaive (ys.drop (ys.length / 2))).Pairwise (· ≤ ·) := by grind - rw [mergeSortNaive] - simp only [hlt, ↓reduceIte] - grind [List.pairwise_merge] - exact hP xs rfl + induction hlen : xs.length using Nat.strong_induction_on generalizing xs with | _ n ih + by_cases hlt : xs.length < 2 + · cases xs with + | nil => + simp [mergeSortNaive] + | cons y xs' => + cases xs' with + | nil => + simp [mergeSortNaive] + | cons z zs => + exact (Nat.not_lt_of_ge (by simp) hlt).elim + · have hge : 2 ≤ xs.length := le_of_not_gt hlt + have hpos : 0 < xs.length := lt_of_lt_of_le (by decide : 0 < (2 : Nat)) hge + have hhalf_lt : xs.length / 2 < xs.length := by grind + have htake_lt : (xs.take (xs.length / 2)).length < xs.length := by + simp only [List.length_take, inf_lt_right, not_le] + grind + have hdrop_lt : (xs.drop (xs.length / 2)).length < xs.length := by + simp only [List.length_drop, tsub_lt_self_iff, Nat.div_pos_iff, Nat.zero_lt_succ, true_and] + grind + have hleft : (mergeSortNaive (xs.take (xs.length / 2))).Pairwise (· ≤ ·) := by grind + have hright : (mergeSortNaive (xs.drop (xs.length / 2))).Pairwise (· ≤ ·) := by grind + rw [mergeSortNaive] + simp only [hlt, ↓reduceIte] + grind [List.pairwise_merge] theorem mergeSort_sorted [LinearOrder α] (xs : List α) : ((mergeSort xs).eval (sortModelNat α)).Pairwise (· ≤ ·) := by From 41d53805a2d344e641c8db241e48f74d976bf080 Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Tue, 24 Feb 2026 19:06:10 +0000 Subject: [PATCH 147/176] substantially golf proofs --- .../Algorithms/ListInsertionSort.lean | 46 +++---- .../Algorithms/ListLinearSearch.lean | 32 ++--- .../Algorithms/ListOrderedInsert.lean | 35 ++--- .../Algorithms/MergeSort.lean | 129 ++++-------------- Cslib/AlgorithmsTheory/QueryModel.lean | 57 ++++---- Cslib/Foundations/Control/Monad/Free.lean | 16 ++- 6 files changed, 120 insertions(+), 195 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index 5aa291653..9ec2798e6 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2026 Shreyas Srinivas. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Shreyas Srinivas +Authors: Shreyas Srinivas, Eric Wieser -/ module @@ -42,51 +42,37 @@ lemma insertionSort_time_compares [LinearOrder α] (head : α) (tail : List α) ((insertionSort tail).time (sortModel α)).compares + ((insertOrd head ((insertionSort tail).eval (sortModel α))).time (sortModel α)).compares := by - have h := congrArg SortOpsCost.compares - (Prog.time.bind (M := sortModel α) (insertionSort tail) (fun rest => insertOrd head rest)) - simp only [HAdd.hAdd, Add.add] at h - simpa [insertionSort] using h + simp [insertionSort] lemma insertionSort_time_inserts [LinearOrder α] (head : α) (tail : List α) : ((insertionSort (head :: tail)).time (sortModel α)).inserts = ((insertionSort tail).time (sortModel α)).inserts + ((insertOrd head ((insertionSort tail).eval (sortModel α))).time (sortModel α)).inserts := by - have h := congrArg SortOpsCost.inserts - (Prog.time.bind (M := sortModel α) (insertionSort tail) (fun rest => insertOrd head rest)) - simp only [HAdd.hAdd, Add.add] at h - simpa [insertionSort] using h + simp [insertionSort] lemma insertionSort_length [LinearOrder α] (l : List α) : ((insertionSort l).eval (sortModel α)).length = l.length := by - induction l with - | nil => - simp [insertionSort] - | cons head tail ih => - have h := insertOrd_length (x := head) ((insertionSort tail).eval (sortModel α)) - simp only [eval, sortModel_evalQuery] at ih - simpa [insertionSort, ih] using h + induction l with simp_all [insertionSort] theorem insertionSort_complexity [LinearOrder α] (l : List α) : ((insertionSort l).time (sortModel α)) ≤ ⟨l.length * (l.length + 1), (l.length + 1) * (l.length + 2)⟩ := by induction l with | nil => - simp only [insertionSort, FreeM.pure_eq_pure, sortModel, time.eq_1, List.length_nil, - zero_add, mul_one, one_mul] - tauto + simp [insertionSort] | cons head tail ih => - have h := insertOrd_complexity_upper_bound ((insertionSort tail).eval (sortModel α)) head - simp_all only [List.length_cons, insertionSort_length] - 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₂] + have h := insertOrd_complexity_upper_bound ((insertionSort tail).eval (sortModel α)) head + simp_all only [List.length_cons, insertionSort_length] + 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 diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index 4374341a6..eb90b81a2 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2025 Shreyas Srinivas. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Shreyas Srinivas +Authors: Shreyas Srinivas, Eric Wieser -/ module @@ -37,22 +37,22 @@ lemma listLinearSearchM_correct_true [BEq α] [LawfulBEq α] (l : List α) {x : (listLinearSearch l x).eval ListSearch.natCost = true := by induction l with | nil => - simp_all only [List.not_mem_nil] + simp_all only [List.not_mem_nil] | cons head tail ih => - simp_all only [eval, List.mem_cons, listLinearSearch, FreeM.lift_def, FreeM.pure_eq_pure, - FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, - LawfulMonad.pure_bind] - split_ifs with h - · obtain (x_head | xtail) := x_mem_l - · rw [x_head] at h - simp only [ListSearch.natCost, List.head?_cons] at h - simp - · specialize ih xtail - simp - · obtain (x_head | x_tail) := x_mem_l - · simp [x_head, ListSearch.natCost] at h - · specialize ih x_tail - simp_all + simp_all only [eval, List.mem_cons, listLinearSearch, FreeM.lift_def, FreeM.pure_eq_pure, + FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, + LawfulMonad.pure_bind] + split_ifs with h + · obtain (x_head | xtail) := x_mem_l + · rw [x_head] at h + simp only [ListSearch.natCost, List.head?_cons] at h + simp + · specialize ih xtail + simp + · obtain (x_head | x_tail) := x_mem_l + · simp [x_head, ListSearch.natCost] at h + · specialize ih x_tail + simp_all lemma listLinearSearchM_correct_false [BEq α] [LawfulBEq α] (l : List α) {x : α} (x_mem_l : x ∉ l) : (listLinearSearch l x).eval ListSearch.natCost = false := by diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index f6b934662..2d95f9d65 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2026 Shreyas Srinivas. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Shreyas Srinivas +Authors: Shreyas Srinivas, Eric Wieser -/ module @@ -27,9 +27,7 @@ def insertOrd (x : α) (l : List α) : Prog (SortOps α) (List α) := do match l with | [] => insertHead x l | a :: as => - let cmp : Bool ← cmpLE x a - if cmp - then + if (← cmpLE x a : Bool) then insertHead x (a :: as) else let res ← insertOrd x as @@ -59,7 +57,7 @@ lemma insertOrd_is_ListOrderedInsert [LinearOrder α] (x : α) (l : List α) : simp [insertOrd, sortModel, List.orderedInsert_cons, h_x] - +@[simp] lemma insertOrd_length [LinearOrder α] (x : α) (l : List α) : ((insertOrd x l).eval (sortModel α)).length = l.length + 1 := by induction l with @@ -71,27 +69,18 @@ lemma insertOrd_length [LinearOrder α] (x : α) (l : List α) : · simp [insertOrd, sortModel, h_head] simpa [Prog.eval] using ih -theorem insertOrd_complexity_upper_bound [LinearOrder α] : - ∀ (l : List α) (x : α), - (insertOrd x l).time (sortModel α) ≤ ⟨l.length, l.length + 1⟩ := by - intro l x +theorem insertOrd_complexity_upper_bound [LinearOrder α] (l : List α) (x : α) : + (insertOrd x l).time (sortModel α) ≤ ⟨l.length, l.length + 1⟩ := by induction l with | nil => - simp [insertOrd, sortModel] + simp [insertOrd, sortModel] | cons head tail ih => - obtain ⟨ih_compares, ih_inserts⟩ := ih - simp only [time, bind_pure_comp, insertOrd, FreeM.lift_def, FreeM.bind_eq_bind, - FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, bind_map_left, - Lean.TimeM.time_bind, List.length_cons, le_def] - split_ifs with h_head - · constructor <;> simp_all - · constructor - · simp_all only [time, sortModel_evalQuery, decide_eq_true_eq, not_le, sortModel_cost, - Lean.TimeM.time_tick, FreeM.liftM_bind, FreeM.liftM_liftBind, bind_pure_comp, - FreeM.liftM_pure, _root_.bind_pure, Lean.TimeM.time_bind, Lean.TimeM.time_map, - add_compares, add_zero] - grind - · simp_all + obtain ⟨ih_compares, ih_inserts⟩ := ih + rw [insertOrd] + by_cases h_head : x ≤ head + · simp [h_head] + · simp [h_head] + grind lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : l.Pairwise (· ≤ ·) → ((insertOrd x l).eval (sortModel α)).Pairwise (· ≤ ·) := by diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 05ebf598b..063543056 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2025 Tanner Duve. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Tanner Duve +Authors: Tanner Duve, Eric Wieser -/ module @@ -90,87 +90,34 @@ private def mergeSortNaive [LinearOrder α] (xs : List α) : List α := let sortedRight := mergeSortNaive (xs.drop (xs.length/2)) List.merge sortedLeft sortedRight -private lemma mergeSort_is_mergeSortNaive [LinearOrder α] (xs : List α) : +private proof_wanted mergeSortNaive_eq_mergeSort [LinearOrder α] (xs : List α) : + mergeSortNaive xs = xs.mergeSort + +private lemma mergeSort_eq_mergeSortNaive [LinearOrder α] (xs : List α) : (mergeSort xs).eval (sortModelNat α) = mergeSortNaive xs := by - classical - induction hlen : xs.length using Nat.strong_induction_on generalizing xs with | _ n ih - by_cases hlt : xs.length < 2 - · nth_rw 1 [mergeSort, mergeSortNaive] - simp [hlt, Prog.eval] - · have hge : 2 ≤ xs.length := by grind - have hpos : 0 < xs.length := by grind - set half : Nat := xs.length / 2 - set left : List α := xs.take half - set right : List α := xs.drop half - have hhalf_lt : half < xs.length := by grind - have hleft_le : left.length ≤ half := by grind - have hleft_lt_len : left.length < xs.length := by grind - have hright_lt_len : right.length < xs.length := by grind - have hleft : (mergeSort left).eval (sortModelNat α) = mergeSortNaive left := by grind - have hright : (mergeSort right).eval (sortModelNat α) = mergeSortNaive right := by grind - have hleft' : - Id.run (FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) - (mergeSort (xs.take (xs.length / 2)))) = - mergeSortNaive (xs.take (xs.length / 2)) := by - simpa [left, half, Prog.eval] using hleft - have hright' : - Id.run (FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) - (mergeSort (xs.drop (xs.length / 2)))) = - mergeSortNaive (xs.drop (xs.length / 2)) := by - simpa [right, half, Prog.eval] using hright - have hmerge (a b : List α) : - Id.run (FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) (merge a b)) = - List.merge a b := by - simpa [Prog.eval] using (merge_eval_eq_listMerge (α := α) a b) - nth_rw 1 [mergeSort, mergeSortNaive] - simp only [hlt, if_false, Prog.eval, bind, FreeM.liftM_bind] - set a := Id.run <| FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) - (mergeSort (List.take (xs.length / 2) xs)) with ha - set b := Id.run <| FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) - (mergeSort (List.drop (xs.length / 2) xs)) with hb - calc - Id.run (FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) - (merge - (Id.run <| FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) - (mergeSort (List.take (xs.length / 2) xs))) - (Id.run <| FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) - (mergeSort (List.drop (xs.length / 2) xs))))) = - Id.run (FreeM.liftM (fun {ι} q => pure <| (sortModelNat α).evalQuery q) (merge a b)) := by - simp [a, b] - _ = List.merge a b := by apply hmerge a b - _ = List.merge (mergeSortNaive (List.take (xs.length / 2) xs)) - (mergeSortNaive (List.drop (xs.length / 2) xs)) := by - simp only [hleft', hright', a, b] + 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_eq_listMerge left right + simp [ihl, ihr, merge_eval_eq_listMerge] rfl private lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : (mergeSortNaive xs).length = xs.length := by - induction hlen : xs.length using Nat.strong_induction_on generalizing xs with | _ n ih - cases hlen - by_cases hlt : xs.length < 2 - · simp [mergeSortNaive, hlt] - · have hge : 2 ≤ xs.length := le_of_not_gt hlt - have hpos : 0 < xs.length := lt_of_lt_of_le (by decide : 0 < (2 : Nat)) hge - have hhalf_lt : xs.length / 2 < xs.length := by grind - have htake_lt : (xs.take (xs.length / 2)).length < xs.length := by - simp only [List.length_take, inf_lt_right, not_le] - grind - have hdrop_lt : (xs.drop (xs.length / 2)).length < xs.length := by - simp only [List.length_drop, tsub_lt_self_iff, Nat.div_pos_iff, Nat.zero_lt_succ, true_and] - grind - have hleft : (mergeSortNaive (xs.take (xs.length / 2))).length = - (xs.take (xs.length / 2)).length := by grind - have hright : (mergeSortNaive (xs.drop (xs.length / 2))).length = - (xs.drop (xs.length / 2)).length := by grind - have hdiv_le : xs.length / 2 ≤ xs.length := Nat.div_le_self _ _ - rw [mergeSortNaive] - simp [hlt, List.length_merge, hleft, hright, List.length_take, List.length_drop, - Nat.min_eq_left hdiv_le, Nat.add_sub_of_le hdiv_le] - + 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 [LinearOrder α] (xs : List α) : ((mergeSort xs).eval (sortModelNat α)).length = xs.length := by - rw [mergeSort_is_mergeSortNaive] + rw [mergeSort_eq_mergeSortNaive] apply mergeSortNaive_length lemma merge_sorted_sorted [LinearOrder α] (xs ys : List α) @@ -181,35 +128,15 @@ lemma merge_sorted_sorted [LinearOrder α] (xs ys : List α) private lemma mergeSortNaive_sorted [LinearOrder α] (xs : List α) : (mergeSortNaive xs).Pairwise (· ≤ ·) := by - induction hlen : xs.length using Nat.strong_induction_on generalizing xs with | _ n ih - by_cases hlt : xs.length < 2 - · cases xs with - | nil => - simp [mergeSortNaive] - | cons y xs' => - cases xs' with - | nil => - simp [mergeSortNaive] - | cons z zs => - exact (Nat.not_lt_of_ge (by simp) hlt).elim - · have hge : 2 ≤ xs.length := le_of_not_gt hlt - have hpos : 0 < xs.length := lt_of_lt_of_le (by decide : 0 < (2 : Nat)) hge - have hhalf_lt : xs.length / 2 < xs.length := by grind - have htake_lt : (xs.take (xs.length / 2)).length < xs.length := by - simp only [List.length_take, inf_lt_right, not_le] - grind - have hdrop_lt : (xs.drop (xs.length / 2)).length < xs.length := by - simp only [List.length_drop, tsub_lt_self_iff, Nat.div_pos_iff, Nat.zero_lt_succ, true_and] - grind - have hleft : (mergeSortNaive (xs.take (xs.length / 2))).Pairwise (· ≤ ·) := by grind - have hright : (mergeSortNaive (xs.drop (xs.length / 2))).Pairwise (· ≤ ·) := by grind - rw [mergeSortNaive] - simp only [hlt, ↓reduceIte] - grind [List.pairwise_merge] + 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 [LinearOrder α] (xs : List α) : ((mergeSort xs).eval (sortModelNat α)).Pairwise (· ≤ ·) := by - rw [mergeSort_is_mergeSortNaive] + rw [mergeSort_eq_mergeSortNaive] apply mergeSortNaive_sorted section TimeComplexity @@ -262,7 +189,7 @@ theorem mergeSort_complexity [LinearOrder α] (xs : List α) : fun_induction mergeSort · simp [T] · expose_names - rw [Prog.time.bind, Prog.time.bind] + simp only [FreeM.bind_eq_bind, Prog.time_bind] have hmerge := merge_timeComplexity ((mergeSort left).eval (sortModelNat α)) ((mergeSort right).eval (sortModelNat α)) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 89eb7420f..f59a273c9 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -77,53 +77,64 @@ abbrev Prog Q α := FreeM Q α /-- The evaluation function of a program `P : Prog Q α` given a model `M : Model Q α` of `Q` -/ -@[simp, grind] +@[grind] def Prog.eval [AddCommMonoid Cost] (P : Prog Q α) (M : Model Q Cost) : α := Id.run <| P.liftM fun x => pure (M.evalQuery x) +@[simp] +theorem Prog.eval_pure [AddCommMonoid Cost] (a : α) (M : Model Q Cost) : + Prog.eval (FreeM.pure a) M = a := + rfl + + +@[simp] +theorem Prog.eval_bind + [AddCommMonoid Cost] (x : Prog Q α) (f : α → Prog Q β) (M : Model Q Cost) : + Prog.eval (FreeM.bind x f) M = Prog.eval (f (Prog.eval x M)) M := by + simp [Prog.eval] + + +@[simp] +theorem Prog.eval_liftBind + [AddCommMonoid Cost] (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. -/ -@[simp, grind] def Prog.time [AddCommMonoid Cost] (P : Prog Q α) (M : Model Q Cost) : Cost := (P.liftM M.timeQuery).time -@[grind =] -lemma Prog.bind_pure : - op >>= FreeM.pure = op := by - simp only [bind, FreeM.bind_pure] +@[simp, grind =] +lemma Prog.time_pure [AddCommMonoid Cost] (a : α) (M : Model Q Cost) : + Prog.time (FreeM.pure a) M = 0 := by + simp [time] -@[grind =] -lemma Prog.pure_bind : - FreeM.pure x >>= m = m x := by - rfl +@[simp, grind =] +theorem Prog.time_liftBind + [AddCommMonoid 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] -@[grind =] -lemma Prog.time.bind [AddCommMonoid Cost] (M : Model Q Cost) +@[simp, grind =] +lemma Prog.time_bind [AddCommMonoid Cost] (M : Model Q Cost) (op : Prog Q ι) (cont : ι → Prog Q α) : - Prog.time (op >>= cont) M = + Prog.time (op.bind cont) M = (Prog.time op M) + (Prog.time (cont (Prog.eval op M)) M):= by - simp only [FreeM.bind_eq_bind, eval] + simp only [eval, time] induction op with | pure a => simp | liftBind op cont' ih => specialize ih (M.evalQuery op) - simp_all only [time, bind_pure_comp, FreeM.liftM_bind, Lean.TimeM.time_bind, + simp_all only [bind_pure_comp, FreeM.liftM_bind, Lean.TimeM.time_bind, FreeM.liftBind_bind, FreeM.liftM_liftBind, bind_map_left, LawfulMonad.pure_bind] rw [add_assoc] -@[grind =] -lemma Prog.time.liftBind [AddCommMonoid Cost] (M : Model Q Cost) - (op : Q ι) (cont : ι → Prog Q α) : - Prog.time (.liftBind op cont) M = - (Prog.time (FreeM.lift op) M) + (Prog.time (cont (M.evalQuery op)) M):= by - simp only [time, bind_pure_comp, FreeM.liftM_liftBind, bind_map_left, Lean.TimeM.time_bind, - Lean.TimeM.time_tick, FreeM.lift_def, FreeM.liftM_pure, _root_.bind_pure, Lean.TimeM.time_map] - section Reduction /-- diff --git a/Cslib/Foundations/Control/Monad/Free.lean b/Cslib/Foundations/Control/Monad/Free.lean index bb12f636f..f75f8e7e0 100644 --- a/Cslib/Foundations/Control/Monad/Free.lean +++ b/Cslib/Foundations/Control/Monad/Free.lean @@ -154,14 +154,26 @@ 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 + +@[grind =] +lemma Prog.pure_bind : + FreeM.pure x >>= m = m x := by + rfl + @[simp] lemma bind_pure_comp (f : α → β) : ∀ x : FreeM F α, x.bind (.pure ∘ f) = map f x | .pure a => rfl From f80426fad60f1ae76e8966d1edbeed101929a50b Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Tue, 24 Feb 2026 19:49:40 +0000 Subject: [PATCH 148/176] golf --- .../Models/ListComparisonSort.lean | 65 +++++++------------ 1 file changed, 23 insertions(+), 42 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 62a8b434d..fcee4f669 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2026 Shreyas Srinivas. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Shreyas Srinivas +Authors: Shreyas Srinivas, Eric WIeser -/ module @@ -19,10 +19,10 @@ 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 type-/ - | cmpLE (x : α) (y : α): SortOps α Bool - /--`insertHead l x` is intended to return `x :: l`-/ + /-- `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 @@ -41,43 +41,29 @@ structure SortOpsCost where inserts : ℕ /-- -Equivalence between SortOpsCost and ℕ +Equivalence between SortOpsCost and a product type. -/ -def SortOpsCost.Equiv : Equiv SortOpsCost (ℕ × ℕ) where +def SortOpsCost.equivProd : SortOpsCost ≃ (ℕ × ℕ) where toFun sortOps := (sortOps.compares, sortOps.inserts) invFun pair := ⟨pair.1, pair.2⟩ - left_inv := by - intro _ - rfl - right_inv := by - intro _ - rfl + left_inv _ := rfl + right_inv _ := rfl + +namespace SortOpsCost @[simps, grind] -instance : Zero SortOpsCost := ⟨0,0⟩ +instance : Zero SortOpsCost := ⟨0, 0⟩ @[simps] instance : LE SortOpsCost where le soc₁ soc₂ := soc₁.compares ≤ soc₂.compares ∧ soc₁.inserts ≤ soc₂.inserts -@[simps] instance : LT SortOpsCost where - lt soc₁ soc₂ := soc₁ ≤ soc₂ ∧ (soc₁.compares < soc₂.compares ∨ soc₁.inserts < soc₂.inserts) + lt soc₁ soc₂ := soc₁ ≤ soc₂ ∧ ¬soc₂ ≤ soc₁ @[grind] -instance : PartialOrder SortOpsCost := by - apply Function.Injective.partialOrder SortOpsCost.Equiv.toEmbedding - · exact SortOpsCost.Equiv.toEmbedding.inj' - · rfl - · intro x y - simp only [lt_def, le_def] - refine ⟨?_, ?_⟩ - · simp only [SortOpsCost.Equiv, Equiv.coe_toEmbedding, Equiv.coe_fn_mk, Prod.mk_lt_mk] - rintro (⟨_, _⟩ | ⟨_, _⟩) - all_goals grind - · simp only [SortOpsCost.Equiv, Equiv.coe_toEmbedding, Equiv.coe_fn_mk, Prod.mk_lt_mk, and_imp] - intros - all_goals grind +instance : PartialOrder SortOpsCost := + fast_instance% SortOpsCost.equivProd.injective.partialOrder _ .rfl .rfl @[simps] instance : Add SortOpsCost where @@ -87,14 +73,11 @@ instance : Add SortOpsCost where instance : SMul ℕ SortOpsCost where smul (n : ℕ) (soc : SortOpsCost) : SortOpsCost := ⟨n • soc.compares, n • soc.inserts⟩ -instance : AddCommMonoid SortOpsCost := by - apply Function.Injective.addCommMonoid SortOpsCost.Equiv.toEmbedding - · exact SortOpsCost.Equiv.toEmbedding.inj' - · rfl - · intro ⟨xcomp, xins⟩ ⟨ycomp, yins⟩ - rfl - · intro x n - rfl +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. @@ -125,11 +108,9 @@ def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where | .insertHead _ _ => 1 @[simp] -lemma sortModelNat_eval_false [LinearOrder α] (y x : α) : - y < x → (sortModelNat α).evalQuery (cmpLE x y) = false := by - intro h - simp only [sortModelNat, decide_eq_false_iff_not, not_le] - exact h +lemma sortModelNat_eval_false [LinearOrder α] (y x : α) (h : y < x) : + (sortModelNat α).evalQuery (cmpLE x y) = false := by + simp [sortModelNat, h] end NatModel From d8c9c602dae9ac661d0995b62c07aadf8e122f23 Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Tue, 24 Feb 2026 20:04:52 +0000 Subject: [PATCH 149/176] more golf --- .../Algorithms/ListOrderedInsert.lean | 47 +++++-------------- 1 file changed, 13 insertions(+), 34 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 2d95f9d65..351921f57 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -33,41 +33,22 @@ def insertOrd (x : α) (l : List α) : Prog (SortOps α) (List α) := do let res ← insertOrd x as insertHead a res -lemma insertOrd_is_ListOrderedInsert [LinearOrder α] (x : α) (l : List α) : - l.Pairwise (· ≤ ·) → (insertOrd x l).eval (sortModel α) = l.orderedInsert (· ≤ ·) x := by - intro h_sorted +@[simp] +lemma insertOrd_eval [LinearOrder α] (x : α) (l : List α) : + (insertOrd x l).eval (sortModel α) = l.orderedInsert (· ≤ ·) x := by induction l with | nil => - simp [insertOrd, sortModel] + simp [insertOrd, sortModel] | cons head tail ih => - rcases List.pairwise_cons.1 h_sorted with ⟨h_head_tail, h_tail_sorted⟩ - by_cases h_head : head ≤ x - · by_cases h_x : x ≤ head - · have hx_head : head = x := le_antisymm h_head h_x - have htail : tail.orderedInsert (· ≤ ·) x = x :: tail := by - cases tail with - | nil => - simp - | cons y ys => - have hy : x ≤ y := by simpa [hx_head] using h_head_tail y (by simp) - simpa using List.orderedInsert_cons_of_le (· ≤ ·) ys hy - simp [insertOrd, sortModel, List.orderedInsert_cons, hx_head] - · simpa [insertOrd, sortModel, List.orderedInsert_cons, h_head, h_x] using ih h_tail_sorted - · have h_x : x ≤ head := le_of_not_ge h_head - simp [insertOrd, sortModel, List.orderedInsert_cons, h_x] - + by_cases h_head : x ≤ head + · simp [insertOrd, h_head] + · simp [insertOrd, h_head, ih] +-- to upstream @[simp] -lemma insertOrd_length [LinearOrder α] (x : α) (l : List α) : - ((insertOrd x l).eval (sortModel α)).length = l.length + 1 := by - induction l with - | nil => - simp [insertOrd, sortModel] - | cons head tail ih => - by_cases h_head : x <= head - · simp [insertOrd, sortModel, h_head] - · simp [insertOrd, sortModel, h_head] - simpa [Prog.eval] using ih +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 [LinearOrder α] (l : List α) (x : α) : (insertOrd x l).time (sortModel α) ≤ ⟨l.length, l.length + 1⟩ := by @@ -84,10 +65,8 @@ theorem insertOrd_complexity_upper_bound [LinearOrder α] (l : List α) (x : α) lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : l.Pairwise (· ≤ ·) → ((insertOrd x l).eval (sortModel α)).Pairwise (· ≤ ·) := by - intro l_mono - rw [insertOrd_is_ListOrderedInsert x l l_mono] - apply List.Pairwise.orderedInsert - assumption + rw [insertOrd_eval] + exact List.Pairwise.orderedInsert _ _ end Algorithms From c617b92108c0e0498b653937d4bc856dd6898aae Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Tue, 24 Feb 2026 20:05:22 +0000 Subject: [PATCH 150/176] more --- .../Algorithms/ListInsertionSort.lean | 32 ++++++++----------- 1 file changed, 14 insertions(+), 18 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index 9ec2798e6..c8f2a19cc 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -27,34 +27,31 @@ def insertionSort (l : List α) : Prog (SortOps α) (List α) := let rest ← insertionSort xs insertOrd x rest +@[simp] +theorem insertionSort_eval [LinearOrder α] (l : List α) : + (insertionSort l).eval (sortModel α) = l.insertionSort (· ≤ ·) := by + induction l with simp_all [insertionSort] + theorem insertionSort_sorted [LinearOrder α] (l : List α) : ((insertionSort l).eval (sortModel α)).Pairwise (· ≤ ·) := by - induction l with - | nil => - simp [insertionSort] - | cons head tail ih => - have h := insertOrd_Sorted ((insertionSort tail).eval (sortModel α)) head ih - simp only [eval, insertionSort, bind, FreeM.liftM_bind] - exact h + simpa using List.pairwise_insertionSort _ _ + +lemma insertionSort_length [LinearOrder α] (l : List α) : + ((insertionSort l).eval (sortModel α)).length = l.length := by + simp lemma insertionSort_time_compares [LinearOrder α] (head : α) (tail : List α) : ((insertionSort (head :: tail)).time (sortModel α)).compares = ((insertionSort tail).time (sortModel α)).compares + - ((insertOrd head ((insertionSort tail).eval - (sortModel α))).time (sortModel α)).compares := by + ((insertOrd head (tail.insertionSort (· ≤ ·))).time (sortModel α)).compares := by simp [insertionSort] lemma insertionSort_time_inserts [LinearOrder α] (head : α) (tail : List α) : ((insertionSort (head :: tail)).time (sortModel α)).inserts = ((insertionSort tail).time (sortModel α)).inserts + - ((insertOrd head ((insertionSort tail).eval (sortModel α))).time - (sortModel α)).inserts := by + ((insertOrd head (tail.insertionSort (· ≤ ·))).time (sortModel α)).inserts := by simp [insertionSort] -lemma insertionSort_length [LinearOrder α] (l : List α) : - ((insertionSort l).eval (sortModel α)).length = l.length := by - induction l with simp_all [insertionSort] - theorem insertionSort_complexity [LinearOrder α] (l : List α) : ((insertionSort l).time (sortModel α)) ≤ ⟨l.length * (l.length + 1), (l.length + 1) * (l.length + 2)⟩ := by @@ -62,8 +59,8 @@ theorem insertionSort_complexity [LinearOrder α] (l : List α) : | nil => simp [insertionSort] | cons head tail ih => - have h := insertOrd_complexity_upper_bound ((insertionSort tail).eval (sortModel α)) head - simp_all only [List.length_cons, insertionSort_length] + have h := insertOrd_complexity_upper_bound (tail.insertionSort (· ≤ ·)) head + simp_all only [List.length_cons, List.length_insertionSort] obtain ⟨ih₁,ih₂⟩ := ih obtain ⟨h₁,h₂⟩ := h refine ⟨?_, ?_⟩ @@ -74,7 +71,6 @@ theorem insertionSort_complexity [LinearOrder α] (l : List α) : rw [insertionSort_time_inserts] nlinarith [ih₂, h₂] - end Algorithms end Cslib From 99b39c31a63e706dbc0308a35da00d1bbdb02b8a Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 22:14:48 +0100 Subject: [PATCH 151/176] mergeSortNaive_Perm --- Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean | 4 ++++ Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 8 ++++++++ 2 files changed, 12 insertions(+) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index c8f2a19cc..1a5480262 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -32,6 +32,10 @@ theorem insertionSort_eval [LinearOrder α] (l : List α) : (insertionSort l).eval (sortModel α) = l.insertionSort (· ≤ ·) := by induction l with simp_all [insertionSort] +theorem insertionSort_permutation [LinearOrder α] (l : List α) : + ((insertionSort l).eval (sortModel α)).Perm l := by + simp [insertionSort_eval, List.perm_insertionSort] + theorem insertionSort_sorted [LinearOrder α] (l : List α) : ((insertionSort l).eval (sortModel α)).Pairwise (· ≤ ·) := by simpa using List.pairwise_insertionSort _ _ diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 063543056..8b27c7e63 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -93,6 +93,14 @@ private def mergeSortNaive [LinearOrder α] (xs : List α) : List α := private proof_wanted mergeSortNaive_eq_mergeSort [LinearOrder α] (xs : List α) : mergeSortNaive xs = xs.mergeSort +private lemma mergeSortNaive_Perm [LinearOrder α] (xs : List α) : + (mergeSortNaive xs).Perm xs := by + fun_induction mergeSortNaive + · simp + · expose_names + rw [←(List.take_append_drop (x.length / 2) x)] + grind [List.merge_perm_append] + private lemma mergeSort_eq_mergeSortNaive [LinearOrder α] (xs : List α) : (mergeSort xs).eval (sortModelNat α) = mergeSortNaive xs := by fun_induction mergeSort with From 24a396b4a615f23007ddddaa41c9cd1c8e0d3286 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 22:15:50 +0100 Subject: [PATCH 152/176] mergeSort_Perm --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 8b27c7e63..ff6524d7c 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -147,6 +147,10 @@ theorem mergeSort_sorted [LinearOrder α] (xs : List α) : rw [mergeSort_eq_mergeSortNaive] apply mergeSortNaive_sorted +theorem mergeSort_perm [LinearOrder α] (xs : List α) : + ((mergeSort xs).eval (sortModelNat α)).Perm xs := by + rw [mergeSort_eq_mergeSortNaive] + apply mergeSortNaive_Perm section TimeComplexity /- I am explicitly borrowing Sorrachai's code, which can be found in `Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort`. But the recurrence is not needed-/ From df89dcfd43ab3dbe16c6c281829c1f2371fc3754 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Tue, 24 Feb 2026 22:16:47 +0100 Subject: [PATCH 153/176] mergeSort_Perm --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index ff6524d7c..b20703738 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -151,6 +151,7 @@ theorem mergeSort_perm [LinearOrder α] (xs : List α) : ((mergeSort xs).eval (sortModelNat α)).Perm xs := by rw [mergeSort_eq_mergeSortNaive] apply mergeSortNaive_Perm + section TimeComplexity /- I am explicitly borrowing Sorrachai's code, which can be found in `Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort`. But the recurrence is not needed-/ From 0ea351b3b9f86604b4aa7ae8f0d81ab17fe2abc1 Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Tue, 24 Feb 2026 22:58:45 +0000 Subject: [PATCH 154/176] golf further --- .../Algorithms/ListLinearSearch.lean | 76 ++++++------------- .../Algorithms/MergeSort.lean | 45 +++++------ .../Models/ListComparisonSearch.lean | 3 +- .../Models/ListComparisonSort.lean | 6 +- Cslib/AlgorithmsTheory/QueryModel.lean | 7 +- Cslib/Foundations/Control/Monad/Free.lean | 9 +-- 6 files changed, 50 insertions(+), 96 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index eb90b81a2..7f6e425fd 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -27,69 +27,39 @@ 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 + 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 - induction l with - | nil => - simp_all only [List.not_mem_nil] - | cons head tail ih => - simp_all only [eval, List.mem_cons, listLinearSearch, FreeM.lift_def, FreeM.pure_eq_pure, - FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, - LawfulMonad.pure_bind] - split_ifs with h - · obtain (x_head | xtail) := x_mem_l - · rw [x_head] at h - simp only [ListSearch.natCost, List.head?_cons] at h - simp - · specialize ih xtail - simp - · obtain (x_head | x_tail) := x_mem_l - · simp [x_head, ListSearch.natCost] at h - · specialize ih x_tail - simp_all + 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 - induction l with - | nil => - simp_all [listLinearSearch, eval] - | cons head tail ih => - simp only [List.mem_cons, not_or] at x_mem_l - specialize ih x_mem_l.2 - simp only [eval, listLinearSearch, bind, FreeM.lift_def, FreeM.pure_eq_pure, - FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind] - split_ifs with h_eq - · simp only [pure, ListSearch.natCost, List.head?_cons] at h_eq - grind - · assumption - -lemma listLinearSearch_correctness [DecidableEq α] (l : List α) (x : α) : - (listLinearSearch l x).eval ListSearch.natCost = l.contains x := by - by_cases hlx : l.contains x - · grind [listLinearSearchM_correct_true] - · grind [listLinearSearchM_correct_false] + simp [x_mem_l] lemma listLinearSearchM_time_complexity_upper_bound [BEq α] (l : List α) (x : α) : - (listLinearSearch l x).time ListSearch.natCost ≤ 1 + l.length := by - induction l with - | nil => - simp_all [listLinearSearch, ListSearch.natCost, time] - | cons head tail ih => - simp_all [listLinearSearch, ListSearch.natCost] - split_ifs with h_head - · simp - · grind + (listLinearSearch l x).time ListSearch.natCost ≤ 1 + l.length := by + fun_induction l.elem x with + | case1 => simp [listLinearSearch] + | case2 => simp_all [listLinearSearch] + | case3 => + simp_all [listLinearSearch] + grind -lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [inon : Nontrivial α] : +-- This statement is wrong +lemma listLinearSearchM_time_complexity_lower_bound [DecidableEq α] [Nonempty α] : ∃ l : List α, ∃ x : α, (listLinearSearch l x).time ListSearch.natCost = l.length := by - obtain ⟨x, y, x_neq_y⟩ := inon - use [x,x,x,x,x,y], y + inhabit α + refine ⟨[], default, ?_⟩ simp_all [ListSearch.natCost, listLinearSearch] end Algorithms diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index b20703738..016d14aa9 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -31,35 +31,28 @@ def merge (x y : List α) : Prog (SortOps α) (List α) := do return (y :: rest) lemma merge_timeComplexity [LinearOrder α] (x y : List α) : - (merge x y).time (sortModelNat α) ≤ x.length + y.length := by - fun_induction merge - · simp - · simp - · expose_names - simp_all only [Prog.time, pure, - List.length_cons, FreeM.lift_def, FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, - FreeM.liftM_liftBind, bind_assoc, Lean.TimeM.time_bind, Lean.TimeM.time_tick] - split_ifs with hxy - · simp_all only [FreeM.liftM_bind, FreeM.liftM_pure, bind_pure_comp, Lean.TimeM.time_map] - simpa [sortModelNat, Lean.TimeM.pure, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] - using (Nat.add_le_add_left ih2 1) - · simp_all only [Bool.not_eq_true, FreeM.liftM_bind, FreeM.liftM_pure, bind_pure_comp, - Lean.TimeM.time_map] - simpa [sortModelNat, Lean.TimeM.pure, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] - using (Nat.add_le_add_left ih1 1) + (merge x y).time (sortModelNat α) ≤ x.length + y.length := by + fun_induction List.merge x y with + | case1 => simp + | case2 => simp + | case3 x xs y ys hxy ihx => + suffices 1 + (merge xs (y :: ys)).time (sortModelNat α) ≤ 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 α) ≤ xs.length + 1 + (ys.length + 1) by + simpa [hxy] + grind lemma merge_eval_eq_listMerge [LinearOrder α] (x y : List α) : (merge x y).eval (sortModelNat α) = List.merge x y := by - fun_induction List.merge - · simp [merge] - · simp [merge] - · expose_names - simp_all [Prog.eval, merge, sortModelNat] - · expose_names - simp_all only [decide_eq_true_eq, not_le, Prog.eval, merge, FreeM.lift_def, FreeM.pure_eq_pure, - FreeM.bind_eq_bind, FreeM.liftBind_bind, FreeM.pure_bind, FreeM.liftM_liftBind, - sortModelNat_eval_false, pure_bind, Bool.false_eq_true, ↓reduceIte, FreeM.liftM_bind, - FreeM.liftM_pure, bind_pure_comp, Id.run_map] + 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 [LinearOrder α] (x y : List α) : ((merge x y).eval (sortModelNat α)).length = x.length + y.length := by diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean index 4352c5392..d3ff94588 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean @@ -30,9 +30,10 @@ inductive ListSearch (α : Type) : Type → Type where /-- A model of the `ListSearch` query type that assigns costs to the queries in `ℕ` -/ +@[simps] def ListSearch.natCost [BEq α] : Model (ListSearch α) ℕ where evalQuery - | .compare l x => l.head? == some x + | .compare l x => some x == l.head? cost | .compare _ _ => 1 diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index fcee4f669..4fe83befe 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -99,6 +99,7 @@ section NatModel 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. -/ +@[simps] def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where evalQuery | .cmpLE x y => decide (x ≤ y) @@ -107,11 +108,6 @@ def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where | .cmpLE _ _ => 1 | .insertHead _ _ => 1 -@[simp] -lemma sortModelNat_eval_false [LinearOrder α] (y x : α) (h : y < x) : - (sortModelNat α).evalQuery (cmpLE x y) = false := by - simp [sortModelNat, h] - end NatModel end Algorithms diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index f59a273c9..e08dcba73 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -77,25 +77,24 @@ abbrev Prog Q α := FreeM Q α /-- The evaluation function of a program `P : Prog Q α` given a model `M : Model Q α` of `Q` -/ -@[grind] def Prog.eval [AddCommMonoid Cost] (P : Prog Q α) (M : Model Q Cost) : α := Id.run <| P.liftM fun x => pure (M.evalQuery x) -@[simp] +@[simp, grind =] theorem Prog.eval_pure [AddCommMonoid Cost] (a : α) (M : Model Q Cost) : Prog.eval (FreeM.pure a) M = a := rfl -@[simp] +@[simp, grind =] theorem Prog.eval_bind [AddCommMonoid Cost] (x : Prog Q α) (f : α → Prog Q β) (M : Model Q Cost) : Prog.eval (FreeM.bind x f) M = Prog.eval (f (Prog.eval x M)) M := by simp [Prog.eval] -@[simp] +@[simp, grind =] theorem Prog.eval_liftBind [AddCommMonoid Cost] (x : Q α) (f : α → Prog Q β) (M : Model Q Cost) : Prog.eval (FreeM.liftBind x f) M = Prog.eval (f <| M.evalQuery x) M := by diff --git a/Cslib/Foundations/Control/Monad/Free.lean b/Cslib/Foundations/Control/Monad/Free.lean index f75f8e7e0..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. -/ @@ -169,11 +169,6 @@ lemma bind_pure : ∀ x : FreeM F α, x.bind (.pure) = x @[simp, grind =] lemma bind_pure' : ∀ x : FreeM F α, x >>= .pure = x := bind_pure -@[grind =] -lemma Prog.pure_bind : - FreeM.pure x >>= m = m x := by - rfl - @[simp] lemma bind_pure_comp (f : α → β) : ∀ x : FreeM F α, x.bind (.pure ∘ f) = map f x | .pure a => rfl From b96744d15db890ca781f8e8fa4468180c1f9ab6f Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Tue, 24 Feb 2026 23:15:02 +0000 Subject: [PATCH 155/176] generalize to total partial orders, to allow stability claims --- .../Algorithms/ListInsertionSort.lean | 39 ++++----- .../Algorithms/ListOrderedInsert.lean | 18 +++-- .../Algorithms/MergeSort.lean | 80 ++++++++++--------- .../Models/ListComparisonSort.lean | 8 +- 4 files changed, 76 insertions(+), 69 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index 1a5480262..dcb39abf9 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -28,42 +28,43 @@ def insertionSort (l : List α) : Prog (SortOps α) (List α) := insertOrd x rest @[simp] -theorem insertionSort_eval [LinearOrder α] (l : List α) : - (insertionSort l).eval (sortModel α) = l.insertionSort (· ≤ ·) := by +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 [LinearOrder α] (l : List α) : - ((insertionSort l).eval (sortModel α)).Perm l := by +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 [LinearOrder α] (l : List α) : - ((insertionSort l).eval (sortModel α)).Pairwise (· ≤ ·) := by +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 [LinearOrder α] (l : List α) : - ((insertionSort l).eval (sortModel α)).length = l.length := by +lemma insertionSort_length (l : List α) (le : α → α → Prop) [DecidableRel le] : + ((insertionSort l).eval (sortModel le)).length = l.length := by simp -lemma insertionSort_time_compares [LinearOrder α] (head : α) (tail : List α) : - ((insertionSort (head :: tail)).time (sortModel α)).compares = - ((insertionSort tail).time (sortModel α)).compares + - ((insertOrd head (tail.insertionSort (· ≤ ·))).time (sortModel α)).compares := by +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 [LinearOrder α] (head : α) (tail : List α) : - ((insertionSort (head :: tail)).time (sortModel α)).inserts = - ((insertionSort tail).time (sortModel α)).inserts + - ((insertOrd head (tail.insertionSort (· ≤ ·))).time (sortModel α)).inserts := by +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 [LinearOrder α] (l : List α) : - ((insertionSort l).time (sortModel α)) +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 (· ≤ ·)) head + 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 diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 351921f57..404115d62 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -34,13 +34,13 @@ def insertOrd (x : α) (l : List α) : Prog (SortOps α) (List α) := do insertHead a res @[simp] -lemma insertOrd_eval [LinearOrder α] (x : α) (l : List α) : - (insertOrd x l).eval (sortModel α) = l.orderedInsert (· ≤ ·) x := by +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 : x ≤ head + by_cases h_head : le x head · simp [insertOrd, h_head] · simp [insertOrd, h_head, ih] @@ -50,21 +50,23 @@ 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 [LinearOrder α] (l : List α) (x : α) : - (insertOrd x l).time (sortModel α) ≤ ⟨l.length, l.length + 1⟩ := by +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 : x ≤ head + by_cases h_head : le x head · simp [h_head] · simp [h_head] grind -lemma insertOrd_Sorted [LinearOrder α] (l : List α) (x : α) : - l.Pairwise (· ≤ ·) → ((insertOrd x l).eval (sortModel α)).Pairwise (· ≤ ·) := by +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 _ _ diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 016d14aa9..e592b9a97 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -30,22 +30,22 @@ def merge (x y : List α) : Prog (SortOps α) (List α) := do let rest ← merge (x :: xs') ys' return (y :: rest) -lemma merge_timeComplexity [LinearOrder α] (x y : List α) : - (merge x y).time (sortModelNat α) ≤ x.length + y.length := by - fun_induction List.merge x y with +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 α) ≤ xs.length + 1 + (ys.length + 1) by + 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 α) ≤ xs.length + 1 + (ys.length + 1) by + suffices 1 + (merge (x :: xs) ys).time (sortModelNat le) ≤ xs.length + 1 + (ys.length + 1) by simpa [hxy] grind -lemma merge_eval_eq_listMerge [LinearOrder α] (x y : List α) : - (merge x y).eval (sortModelNat α) = List.merge x y := by +lemma merge_eval_eq_listMerge (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 @@ -54,8 +54,8 @@ lemma merge_eval_eq_listMerge [LinearOrder α] (x y : List α) : rw [decide_eq_true_iff] at hxy simp_all [merge, -not_le] -lemma merge_length [LinearOrder α] (x y : List α) : - ((merge x y).eval (sortModelNat α)).length = x.length + y.length := by +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_eq_listMerge] apply List.length_merge @@ -76,26 +76,27 @@ def mergeSort (xs : List α) : Prog (SortOps α) (List α) := do /-- The vanilla-lean version of `mergeSortNaive` that is extensionally equal to `mergeSort` -/ -private def mergeSortNaive [LinearOrder α] (xs : List α) : List α := +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)) - let sortedRight := mergeSortNaive (xs.drop (xs.length/2)) - List.merge sortedLeft sortedRight + 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 α) : - mergeSortNaive xs = xs.mergeSort +private proof_wanted mergeSortNaive_eq_mergeSort + [LinearOrder α] (xs : List α) (le : α → α → Prop) [DecidableRel le] : + mergeSortNaive xs le = xs.mergeSort -private lemma mergeSortNaive_Perm [LinearOrder α] (xs : List α) : - (mergeSortNaive xs).Perm xs := by +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)] - grind [List.merge_perm_append] + grw [List.merge_perm_append, ← ih1, ← ih2] -private lemma mergeSort_eq_mergeSortNaive [LinearOrder α] (xs : List α) : - (mergeSort xs).eval (sortModelNat α) = mergeSortNaive xs := by +private lemma mergeSort_eq_mergeSortNaive (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] @@ -105,8 +106,8 @@ private lemma mergeSort_eq_mergeSortNaive [LinearOrder α] (xs : List α) : simp [ihl, ihr, merge_eval_eq_listMerge] rfl -private lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : - (mergeSortNaive xs).length = xs.length := by +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 @@ -116,32 +117,35 @@ private lemma mergeSortNaive_length [LinearOrder α] (xs : List α) : rw [← List.length_append] simp -lemma mergeSort_length [LinearOrder α] (xs : List α) : - ((mergeSort xs).eval (sortModelNat α)).length = xs.length := by +lemma mergeSort_length (xs : List α) (le : α → α → Prop) [DecidableRel le] : + ((mergeSort xs).eval (sortModelNat le)).length = xs.length := by rw [mergeSort_eq_mergeSortNaive] apply mergeSortNaive_length -lemma merge_sorted_sorted [LinearOrder α] (xs ys : List α) - (hxs_mono : xs.Pairwise (· ≤ ·)) (hys_mono : ys.Pairwise (· ≤ ·)) : - ((merge xs ys).eval (sortModelNat α)).Pairwise (· ≤ ·) := by +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_eq_listMerge] - grind [List.pairwise_merge] + grind [hxs_mono.merge hys_mono] -private lemma mergeSortNaive_sorted [LinearOrder α] (xs : List α) : - (mergeSortNaive xs).Pairwise (· ≤ ·) := by +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 [LinearOrder α] (xs : List α) : - ((mergeSort xs).eval (sortModelNat α)).Pairwise (· ≤ ·) := by +theorem mergeSort_sorted + (xs : List α) (le : α → α → Prop) [DecidableRel le] [Std.Total le] [IsTrans _ le] : + ((mergeSort xs).eval (sortModelNat le)).Pairwise le := by rw [mergeSort_eq_mergeSortNaive] apply mergeSortNaive_sorted -theorem mergeSort_perm [LinearOrder α] (xs : List α) : - ((mergeSort xs).eval (sortModelNat α)).Perm xs := by +theorem mergeSort_perm (xs : List α) (le : α → α → Prop) [DecidableRel le] : + ((mergeSort xs).eval (sortModelNat le)).Perm xs := by rw [mergeSort_eq_mergeSortNaive] apply mergeSortNaive_Perm @@ -190,15 +194,15 @@ lemma T_monotone : Monotone T := by simp only [T] exact Nat.mul_le_mul h_ij (Nat.clog_monotone 2 h_ij) -theorem mergeSort_complexity [LinearOrder α] (xs : List α) : - ((mergeSort xs).time (sortModelNat α)) ≤ (T (xs.length)) := by +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] have hmerge := merge_timeComplexity - ((mergeSort left).eval (sortModelNat α)) - ((mergeSort right).eval (sortModelNat α)) + ((mergeSort left).eval (sortModelNat le)) + ((mergeSort right).eval (sortModelNat le)) grw [hmerge, ih1, ih2, mergeSort_length, mergeSort_length] set n := x.length have hleft_len : left.length ≤ n / 2 := by diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 4fe83befe..fb28dcb16 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -83,9 +83,9 @@ end SortOpsCost A model of `SortOps` that uses `SortOpsCost` as the cost type for operations. -/ @[simps, grind] -def sortModel (α : Type) [LinearOrder α] : Model (SortOps α) SortOpsCost where +def sortModel {α : Type} (le : α → α → Prop) [DecidableRel le] : Model (SortOps α) SortOpsCost where evalQuery - | .cmpLE x y => decide (x ≤ y) + | .cmpLE x y => decide (le x y) | .insertHead x l => x :: l cost | .cmpLE _ _ => ⟨1,0⟩ @@ -100,9 +100,9 @@ A model of `SortOps` that uses `ℕ` as the type for the cost of operations. In both comparisons and insertions are counted in a single `ℕ` parameter. -/ @[simps] -def sortModelNat (α : Type) [LinearOrder α] : Model (SortOps α) ℕ where +def sortModelNat {α : Type} (le : α → α → Prop) [DecidableRel le] : Model (SortOps α) ℕ where evalQuery - | .cmpLE x y => decide (x ≤ y) + | .cmpLE x y => decide (le x y) | .insertHead x l => x :: l cost | .cmpLE _ _ => 1 From 93b91352910669d1d378ac640b75e9ea706c4a89 Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Tue, 24 Feb 2026 23:44:38 +0000 Subject: [PATCH 156/176] fix whitespace, use notation --- Cslib/AlgorithmsTheory/QueryModel.lean | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index e08dcba73..0cd0537e8 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -66,7 +66,7 @@ open Cslib.Algorithms.Lean in /-- lift `Model.cost` to `TimeM Cost ι` -/ abbrev Model.timeQuery [AddCommMonoid Cost] (M : Model Q Cost) (x : Q ι) : TimeM Cost ι := do - TimeM.tick (M.cost x); return (M.evalQuery x) + ✓[M.cost x] return M.evalQuery x /-- A program is defined as a Free Monad over a Query type `Q` which operates on a base type `α` @@ -90,14 +90,14 @@ theorem Prog.eval_pure [AddCommMonoid Cost] (a : α) (M : Model Q Cost) : @[simp, grind =] theorem Prog.eval_bind [AddCommMonoid Cost] (x : Prog Q α) (f : α → Prog Q β) (M : Model Q Cost) : - Prog.eval (FreeM.bind x f) M = Prog.eval (f (Prog.eval x M)) M := by + Prog.eval (FreeM.bind x f) M = Prog.eval (f (x.eval M)) M := by simp [Prog.eval] @[simp, grind =] theorem Prog.eval_liftBind [AddCommMonoid Cost] (x : Q α) (f : α → Prog Q β) (M : Model Q Cost) : - Prog.eval (FreeM.liftBind x f) M = Prog.eval (f <| M.evalQuery x) M := by + Prog.eval (FreeM.liftBind x f) M = Prog.eval (f <| M.evalQuery x) M := by simp [Prog.eval] /-- @@ -123,16 +123,16 @@ theorem Prog.time_liftBind 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 + Prog.time op M + Prog.time (cont (Prog.eval op M)) M := by simp only [eval, time] induction op with | pure a => - simp + simp | liftBind op cont' ih => - specialize ih (M.evalQuery op) - simp_all only [bind_pure_comp, FreeM.liftM_bind, Lean.TimeM.time_bind, - FreeM.liftBind_bind, FreeM.liftM_liftBind, bind_map_left, LawfulMonad.pure_bind] - rw [add_assoc] + specialize ih (M.evalQuery op) + simp_all only [bind_pure_comp, FreeM.liftM_bind, Lean.TimeM.time_bind, + FreeM.liftBind_bind, FreeM.liftM_liftBind, bind_map_left, LawfulMonad.pure_bind] + rw [add_assoc] section Reduction From c19709e54427ffe7b2dd1152f0db3fe6a7503888 Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Wed, 25 Feb 2026 00:03:45 +0000 Subject: [PATCH 157/176] whitespace and docstrings --- .../AlgorithmsTheory/Algorithms/ListInsertionSort.lean | 4 +--- .../AlgorithmsTheory/Algorithms/ListLinearSearch.lean | 4 +--- .../AlgorithmsTheory/Models/ListComparisonSearch.lean | 4 +--- Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean | 10 +++++++--- Cslib/AlgorithmsTheory/QueryModel.lean | 5 ----- 5 files changed, 10 insertions(+), 17 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index dcb39abf9..c46bcfa8f 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -17,9 +17,7 @@ namespace Algorithms open Prog -/-- -The insertionSort algorithms on lists with the `SortOps` query --/ +/-- The insertionSort algorithms on lists with the `SortOps` query. -/ def insertionSort (l : List α) : Prog (SortOps α) (List α) := match l with | [] => return [] diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index 7f6e425fd..b72f237fa 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -20,9 +20,7 @@ namespace Algorithms open Prog open ListSearch in -/-- -Linear Search in Lists on top of the `ListSearch` query model. --/ +/-- 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 diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean index d3ff94588..e83f68ee8 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean @@ -27,9 +27,7 @@ inductive ListSearch (α : Type) : Type → Type where | compare (a : List α) (val : α) : ListSearch α Bool -/-- -A model of the `ListSearch` query type that assigns costs to the queries in `ℕ` --/ +/-- 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 diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index fb28dcb16..1f2e9a5a5 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -40,9 +40,7 @@ structure SortOpsCost where /-- `inserts` counts the number of calls to `insertHead` -/ inserts : ℕ -/-- -Equivalence between SortOpsCost and a product type. --/ +/-- Equivalence between SortOpsCost and a product type. -/ def SortOpsCost.equivProd : SortOpsCost ≃ (ℕ × ℕ) where toFun sortOps := (sortOps.compares, sortOps.inserts) invFun pair := ⟨pair.1, pair.2⟩ @@ -81,6 +79,9 @@ 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 @@ -98,6 +99,9 @@ section NatModel /-- 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 (SortOps α) ℕ where diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 0cd0537e8..361bb247e 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -26,7 +26,6 @@ parametric type of query operations. under the hood - `eval`, `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 @@ -61,7 +60,6 @@ structure Model (QType : Type u → Type u) (Cost : Type) [AddCommMonoid Cost] w including but not limited to time complexity -/ cost : QType ι → Cost - open Cslib.Algorithms.Lean in /-- lift `Model.cost` to `TimeM Cost ι` -/ abbrev Model.timeQuery [AddCommMonoid Cost] @@ -86,14 +84,12 @@ theorem Prog.eval_pure [AddCommMonoid Cost] (a : α) (M : Model Q Cost) : Prog.eval (FreeM.pure a) M = a := rfl - @[simp, grind =] theorem Prog.eval_bind [AddCommMonoid Cost] (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 [AddCommMonoid Cost] (x : Q α) (f : α → Prog Q β) (M : Model Q Cost) : @@ -151,7 +147,6 @@ structure Reduction (Q₁ Q₂ : Type u → Type u) where abbrev Prog.reduceProg (P : Prog Q₁ α) (red : Reduction Q₁ Q₂) : Prog Q₂ α := P.liftM red.reduce - end Reduction end Cslib.Algorithms From 013464ca4f883dc7eddea7c9ccd120cb84828446 Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Wed, 25 Feb 2026 00:19:44 +0000 Subject: [PATCH 158/176] . in docstrings --- Cslib/AlgorithmsTheory/QueryModel.lean | 31 ++++++++++++-------------- 1 file changed, 14 insertions(+), 17 deletions(-) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 361bb247e..f34da511e 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -20,25 +20,24 @@ parametric type of query operations. ## Main definitions -- `PureCosts` : A typeclass that every model needs to log or cost pure monadic operations -- `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 -- `eval`, `time` : concrete execution semantics of a `Prog Q α` for a given model of `Q` +- `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. + 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 + 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 α`. + each query `q : Q` is automatically lifted into `Prog Q α`. ## Tags query model, free monad, time complexity, Prog @@ -53,11 +52,11 @@ 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 u) (Cost : Type) [AddCommMonoid Cost] where - /-- Evaluates a query `q : Q ι` to return a result of type `ι` -/ + /-- 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 -/ + including but not limited to time complexity. -/ cost : QType ι → Cost open Cslib.Algorithms.Lean in @@ -132,9 +131,7 @@ lemma Prog.time_bind [AddCommMonoid Cost] (M : Model Q Cost) section Reduction -/-- -A reduction structure from query type `Q₁` to query type `Q₂`. --/ +/-- 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₂` -/ @@ -142,7 +139,7 @@ structure Reduction (Q₁ Q₂ : Type u → Type u) where /-- `Prog.reduceProg` takes a reduction structure from a query `Q₁` to `Q₂` and extends its -`reduce` function to programs on the query type `Q₁` +`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 From d7010683a03101a05393f35216d4247a105d399c Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Wed, 25 Feb 2026 00:20:32 +0000 Subject: [PATCH 159/176] generalize theorems --- Cslib/AlgorithmsTheory/QueryModel.lean | 31 ++++++++++++++------------ 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index f34da511e..ab7eabf42 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -51,7 +51,7 @@ 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 u) (Cost : Type) [AddCommMonoid Cost] where +structure Model (QType : Type u → Type u) (Cost : Type) 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`. @@ -59,11 +59,12 @@ structure Model (QType : Type u → Type u) (Cost : Type) [AddCommMonoid Cost] w including but not limited to time complexity. -/ cost : QType ι → Cost + open Cslib.Algorithms.Lean in /-- lift `Model.cost` to `TimeM Cost ι` -/ -abbrev Model.timeQuery [AddCommMonoid Cost] - (M : Model Q Cost) (x : Q ι) : TimeM Cost ι := do - ✓[M.cost x] return M.evalQuery x +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 `α` @@ -74,43 +75,45 @@ 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 [AddCommMonoid Cost] +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 [AddCommMonoid Cost] (a : α) (M : Model Q Cost) : +theorem Prog.eval_pure (a : α) (M : Model Q Cost) : Prog.eval (FreeM.pure a) M = a := rfl @[simp, grind =] theorem Prog.eval_bind - [AddCommMonoid Cost] (x : Prog Q α) (f : α → Prog Q β) (M : Model Q Cost) : + (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 - [AddCommMonoid Cost] (x : Q α) (f : α → Prog Q β) (M : Model Q Cost) : + (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 [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 [AddCommMonoid Cost] (a : α) (M : Model Q Cost) : +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 - [AddCommMonoid Cost] (x : Q α) (f : α → Prog Q β) (M : Model Q Cost) : +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] @@ -125,8 +128,8 @@ lemma Prog.time_bind [AddCommMonoid Cost] (M : Model Q Cost) simp | liftBind op cont' ih => specialize ih (M.evalQuery op) - simp_all only [bind_pure_comp, FreeM.liftM_bind, Lean.TimeM.time_bind, - FreeM.liftBind_bind, FreeM.liftM_liftBind, bind_map_left, LawfulMonad.pure_bind] + simp_all only [FreeM.liftM_bind, Lean.TimeM.time_bind, + FreeM.liftBind_bind, FreeM.liftM_liftBind, LawfulMonad.pure_bind] rw [add_assoc] section Reduction From ac2b2b01cbbb24a6c308cb9210cd7c5af674fabd Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Wed, 25 Feb 2026 01:50:37 +0000 Subject: [PATCH 160/176] Deduplicate proofs --- .../Algorithms/MergeSort.lean | 77 +++++-------------- .../Lean/MergeSort/MergeSort.lean | 4 + Cslib/AlgorithmsTheory/QueryModel.lean | 4 +- 3 files changed, 24 insertions(+), 61 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index e592b9a97..f5f18571c 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -8,6 +8,8 @@ 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 @@ -44,7 +46,8 @@ lemma merge_timeComplexity (x y : List α) (le : α → α → Prop) [DecidableR simpa [hxy] grind -lemma merge_eval_eq_listMerge (x y : List α) (le : α → α → Prop) [DecidableRel le] : +@[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 @@ -56,7 +59,7 @@ lemma merge_eval_eq_listMerge (x y : List α) (le : α → α → Prop) [Decidab 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_eq_listMerge] + rw [merge_eval] apply List.length_merge /-- @@ -95,15 +98,16 @@ private lemma mergeSortNaive_Perm (xs : List α) (le : α → α → Prop) [Deci rw [←(List.take_append_drop (x.length / 2) x)] grw [List.merge_perm_append, ← ih1, ← ih2] -private lemma mergeSort_eq_mergeSortNaive (xs : List α) (le : α → α → Prop) [DecidableRel le] : +@[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_eq_listMerge left right - simp [ihl, ihr, merge_eval_eq_listMerge] + have im := merge_eval left right + simp [ihl, ihr, merge_eval] rfl private lemma mergeSortNaive_length (xs : List α) (le : α → α → Prop) [DecidableRel le] : @@ -119,14 +123,14 @@ private lemma mergeSortNaive_length (xs : List α) (le : α → α → Prop) [De lemma mergeSort_length (xs : List α) (le : α → α → Prop) [DecidableRel le] : ((mergeSort xs).eval (sortModelNat le)).length = xs.length := by - rw [mergeSort_eq_mergeSortNaive] + 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_eq_listMerge] + rw [merge_eval] grind [hxs_mono.merge hys_mono] private lemma mergeSortNaive_sorted @@ -141,69 +145,26 @@ private lemma mergeSortNaive_sorted theorem mergeSort_sorted (xs : List α) (le : α → α → Prop) [DecidableRel le] [Std.Total le] [IsTrans _ le] : ((mergeSort xs).eval (sortModelNat le)).Pairwise le := by - rw [mergeSort_eq_mergeSortNaive] + 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_eq_mergeSortNaive] + rw [mergeSort_eval] apply mergeSortNaive_Perm section TimeComplexity -/- I am explicitly borrowing Sorrachai's code, which can be found in -`Cslib.AlgorithmsTheory.Lean.MergeSort.MergeSort`. But the recurrence is not needed-/ - -open Nat (clog) - -/-- Key Lemma: ⌈log2 ⌈n/2⌉⌉ ≤ ⌈log2 n⌉ - 1 for n > 1 -/ -@[grind →] -lemma clog2_half_le (n : ℕ) (h : n > 1) : clog 2 ((n + 1) / 2) ≤ clog 2 n - 1 := by - rw [Nat.clog_of_one_lt one_lt_two h] - grind - -/-- Same logic for the floor half: ⌈log2 ⌊n/2⌋⌉ ≤ ⌈log2 n⌉ - 1 -/ -@[grind →] -lemma clog2_floor_half_le (n : ℕ) (h : n > 1) : clog 2 (n / 2) ≤ clog 2 n - 1 := by - apply Nat.le_trans _ (clog2_half_le n h) - apply Nat.clog_monotone - grind - -@[grind .] -private lemma some_algebra (n : ℕ) : - (n / 2 + 1) * clog 2 (n / 2 + 1) + ((n + 1) / 2 + 1) * clog 2 ((n + 1) / 2 + 1) + (n + 2) ≤ - (n + 2) * clog 2 (n + 2) := by - -- 1. Substitution: Let N = n_1 + 2 to clean up the expression - let N := n + 2 - have hN : N ≥ 2 := by omega - -- 2. Rewrite the terms using N - have t1 : n / 2 + 1 = N / 2 := by omega - have t2 : (n + 1) / 2 + 1 = (N + 1) / 2 := by omega - have t3 : n + 1 + 1 = N := by omega - let k := clog 2 N - have h_bound_l : clog 2 (N / 2) ≤ k - 1 := clog2_floor_half_le N hN - have h_bound_r : clog 2 ((N + 1) / 2) ≤ k - 1 := clog2_half_le N hN - have h_split : N / 2 + (N + 1) / 2 = N := by omega - grw [t1, t2, t3, h_bound_l, h_bound_r, ←Nat.add_mul, h_split] - exact Nat.le_refl (N * (k - 1) + 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 - simp only [T] - exact Nat.mul_le_mul h_ij (Nat.clog_monotone 2 h_ij) +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 + (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] - have hmerge := merge_timeComplexity - ((mergeSort left).eval (sortModelNat le)) - ((mergeSort right).eval (sortModelNat le)) - grw [hmerge, ih1, ih2, mergeSort_length, mergeSort_length] + 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 diff --git a/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean b/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean index 07fa07702..081dbf1b7 100644 --- a/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Lean/MergeSort/MergeSort.lean @@ -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/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index ab7eabf42..4a7f6cbde 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -128,9 +128,7 @@ lemma Prog.time_bind [AddCommMonoid Cost] (M : Model Q Cost) simp | liftBind op cont' ih => specialize ih (M.evalQuery op) - simp_all only [FreeM.liftM_bind, Lean.TimeM.time_bind, - FreeM.liftBind_bind, FreeM.liftM_liftBind, LawfulMonad.pure_bind] - rw [add_assoc] + simp_all [add_assoc] section Reduction From 3917fea2756d85b739a18e36495c23e51e69c183 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 25 Feb 2026 04:09:11 +0100 Subject: [PATCH 161/176] Use SortOpsNat with only cmpLE for mergeSort --- Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean | 6 +++--- .../AlgorithmsTheory/Models/ListComparisonSort.lean | 13 ++++++++++--- 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index f5f18571c..a7c9a062f 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -15,11 +15,11 @@ import all Init.Data.List.Sort.Basic namespace Cslib.Algorithms -open SortOps +open SortOpsNat /-- Merge two sorted lists using comparisons in the query monad. -/ @[simp] -def merge (x y : List α) : Prog (SortOps α) (List α) := do +def merge (x y : List α) : Prog (SortOpsNat α) (List α) := do match x,y with | [], ys => return ys | xs, [] => return xs @@ -66,7 +66,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 (SortOps α) (List α) := do +def mergeSort (xs : List α) : Prog (SortOpsNat α) (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 1f2e9a5a5..c5a4bb585 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -96,6 +96,15 @@ end SortOpsCostModel section NatModel +/-- +A model for comparison sorting on lists with only the comparison operation. This +is used in mergeSort +-/ +inductive SortOpsNat (α : 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 : α) : SortOpsNat α 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. @@ -104,13 +113,11 @@ While this accepts any decidable relation `le`, most sorting algorithms are only presence of `[Std.Total le] [IsTrans _ le]`. -/ @[simps] -def sortModelNat {α : Type} (le : α → α → Prop) [DecidableRel le] : Model (SortOps α) ℕ where +def sortModelNat {α : Type} (le : α → α → Prop) [DecidableRel le] : Model (SortOpsNat α) ℕ where evalQuery | .cmpLE x y => decide (le x y) - | .insertHead x l => x :: l cost | .cmpLE _ _ => 1 - | .insertHead _ _ => 1 end NatModel From ae1cbca3fbd9cc8e4b10b311d335f07470b54453 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 25 Feb 2026 04:23:17 +0100 Subject: [PATCH 162/176] Use SortOpsCmp with only cmpLE for mergeSort --- .../Algorithms/MergeSort.lean | 6 ++--- .../Models/ListComparisonSearch.lean | 14 ++++++++++ .../Models/ListComparisonSort.lean | 26 ++++++++++++++++--- 3 files changed, 40 insertions(+), 6 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index a7c9a062f..8636ac11f 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -15,11 +15,11 @@ import all Init.Data.List.Sort.Basic namespace Cslib.Algorithms -open SortOpsNat +open SortOpsCmp /-- Merge two sorted lists using comparisons in the query monad. -/ @[simp] -def merge (x y : List α) : Prog (SortOpsNat α) (List α) := do +def merge (x y : List α) : Prog (SortOpsCmp α) (List α) := do match x,y with | [], ys => return ys | xs, [] => return xs @@ -66,7 +66,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 (SortOpsNat α) (List α) := do +def mergeSort (xs : List α) : Prog (SortOpsCmp α) (List α) := do if xs.length < 2 then return xs else let half := xs.length / 2 diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean index e83f68ee8..5e53f2213 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean @@ -11,6 +11,20 @@ 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 diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index c5a4bb585..0be5dbaf1 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -10,11 +10,30 @@ 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. -/ @@ -100,10 +119,10 @@ section NatModel A model for comparison sorting on lists with only the comparison operation. This is used in mergeSort -/ -inductive SortOpsNat (α : Type) : Type → Type where +inductive SortOpsCmp (α : 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 : α) : SortOpsNat α Bool + | cmpLE (x : α) (y : α) : SortOpsCmp α Bool /-- A model of `SortOps` that uses `ℕ` as the type for the cost of operations. In this model, @@ -113,7 +132,8 @@ While this accepts any decidable relation `le`, most sorting algorithms are only presence of `[Std.Total le] [IsTrans _ le]`. -/ @[simps] -def sortModelNat {α : Type} (le : α → α → Prop) [DecidableRel le] : Model (SortOpsNat α) ℕ where +def sortModelNat {α : Type} + (le : α → α → Prop) [DecidableRel le] : Model (SortOpsCmp α) ℕ where evalQuery | .cmpLE x y => decide (le x y) cost From 597f4de7bbeef722e0da8cc47c5ebe8e6429b820 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 25 Feb 2026 04:28:04 +0100 Subject: [PATCH 163/176] Fix line lengths in linear search --- .../AlgorithmsTheory/Algorithms/ListLinearSearch.lean | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index b72f237fa..941257496 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -1,5 +1,5 @@ /- -Copyright (c) 2025 Shreyas Srinivas. All rights reserved. +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 -/ @@ -36,12 +36,12 @@ 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 +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 +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 : α) : From f1e1496f064fed173887c19da91692a63b9ba1c3 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 25 Feb 2026 04:36:08 +0100 Subject: [PATCH 164/176] insertOrd module docstring --- .../Algorithms/ListOrderedInsert.lean | 22 +++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 404115d62..559c27a99 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -12,6 +12,28 @@ 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`. +- `mergeSort_time` : The number of comparisons of `mergeSort` is at most `n*⌈log₂ n⌉`. +- `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 From 2bcedcb967aaa703922d6fd217490a622da67d44 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 25 Feb 2026 04:42:26 +0100 Subject: [PATCH 165/176] insertionSort module docstring --- .../Algorithms/ListInsertionSort.lean | 23 +++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index c46bcfa8f..cf053e92c 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -11,6 +11,29 @@ 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` : The list output by insertion sort is a permutation of the input + list. +- `insertionSort_sorted` : The list output by insertion sort is sorted. +- `insertOrd_sorted` : Applying `insertOrd` to a sorted list yields a sorted list. +- `insertionSort_complexity` : insertion sort takes at most n * (n + 1) comparisons and + (n + 1) * (n + 2) list head-insertions. +-/ + namespace Cslib namespace Algorithms From e245e2192779d3740ffd4e6097f5818d99f4a69a Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 25 Feb 2026 04:51:33 +0100 Subject: [PATCH 166/176] mergeSort module docstring --- .../Algorithms/ListInsertionSort.lean | 5 ++--- .../Algorithms/MergeSort.lean | 22 +++++++++++++++++-- 2 files changed, 22 insertions(+), 5 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index cf053e92c..822da6910 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -28,9 +28,8 @@ the `SortOps` model. This insertionSort evaluates identically to the upstream ve - `insertionSort_eval`: `insertionSort` evaluates identically to `List.insertionSort`. - `insertionSort_permutation` : The list output by insertion sort is a permutation of the input list. -- `insertionSort_sorted` : The list output by insertion sort is sorted. -- `insertOrd_sorted` : Applying `insertOrd` to a sorted list yields a sorted list. -- `insertionSort_complexity` : insertion sort takes at most n * (n + 1) comparisons and +- `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. -/ diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 8636ac11f..4cb7e8f4c 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2025 Tanner Duve. All rights reserved. +Copyright (c) 2026 Shreyas Srinivas. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Tanner Duve, Eric Wieser +Authors: Shreyas Srinivas, Eric Wieser -/ module @@ -13,6 +13,24 @@ 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 From e7e24cbfb9678c2829f11d680d4fa8e1d3381d8c Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 25 Feb 2026 04:52:04 +0100 Subject: [PATCH 167/176] mergeSort module docstring --- Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean index 822da6910..86c85c3ee 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListInsertionSort.lean @@ -26,8 +26,7 @@ the `SortOps` model. This insertionSort evaluates identically to the upstream ve ## Main results - `insertionSort_eval`: `insertionSort` evaluates identically to `List.insertionSort`. -- `insertionSort_permutation` : The list output by insertion sort is a permutation of the input - list. +- `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. From 3ce18561a88d4979944834a700fd84c2a201a25a Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 25 Feb 2026 05:07:09 +0100 Subject: [PATCH 168/176] linear search docstring --- .../Algorithms/ListLinearSearch.lean | 20 ++++++++++++++++++- .../Algorithms/ListOrderedInsert.lean | 1 - .../Algorithms/MergeSort.lean | 2 +- 3 files changed, 20 insertions(+), 3 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean index 941257496..0a1f5c3a9 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListLinearSearch.lean @@ -12,7 +12,25 @@ 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 @@ -45,7 +63,7 @@ lemma listLinearSearchM_correct_false [BEq α] [LawfulBEq α] (l : List α) simp [x_mem_l] lemma listLinearSearchM_time_complexity_upper_bound [BEq α] (l : List α) (x : α) : - (listLinearSearch l x).time ListSearch.natCost ≤ 1 + l.length := by + (listLinearSearch l x).time ListSearch.natCost ≤ l.length := by fun_induction l.elem x with | case1 => simp [listLinearSearch] | case2 => simp_all [listLinearSearch] diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 559c27a99..00a869a85 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -28,7 +28,6 @@ in upstream libraries for the pure lean code versions of these declarations. ## Main results - `insertOrd_eval`: `insertOrd` evaluates identically to `List.orderedInsert`. -- `mergeSort_time` : The number of comparisons of `mergeSort` is at most `n*⌈log₂ n⌉`. - `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. diff --git a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean index 4cb7e8f4c..a2a235984 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/MergeSort.lean @@ -29,7 +29,7 @@ the `SortOps` model. - `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. +- `mergeSort_complexity` : `mergeSort` takes at most n * ⌈log n⌉ comparisons. -/ namespace Cslib.Algorithms From cb286064c96341c7904bf3c29d7588de70944470 Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 25 Feb 2026 05:17:29 +0100 Subject: [PATCH 169/176] linear search docstring --- Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean | 2 +- Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean index 00a869a85..4a0ebfb93 100644 --- a/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean +++ b/Cslib/AlgorithmsTheory/Algorithms/ListOrderedInsert.lean @@ -29,7 +29,7 @@ in upstream libraries for the pure lean code versions of these declarations. - `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. + and `n + 1` list head-insertion operations. - `insertOrd_sorted` : Applying `insertOrd` to a sorted list yields a sorted list. -/ diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 0be5dbaf1..952f2d106 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -21,11 +21,11 @@ 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. + 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 + This is more suitable for comparison based sorts for which it is only desirable to count + comparisons -/ namespace Cslib From 34ac82cb6df0a9781b0d3c35955863bc5ad3867a Mon Sep 17 00:00:00 2001 From: Shreyas Date: Wed, 25 Feb 2026 05:19:00 +0100 Subject: [PATCH 170/176] Fix comments --- Cslib/AlgorithmsTheory/QueryModel.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 4a7f6cbde..1a8f1dc7e 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -1,7 +1,7 @@ /- 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 +Authors: Tanner Duve, Shreyas Srinivas, Eric Wieser -/ module From ab6869438e35931055a1b1bd13c9e8ab6c9d7b4c Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Wed, 25 Feb 2026 04:24:29 +0000 Subject: [PATCH 171/176] fix style in tests --- CslibTests/QueryModel/ProgExamples.lean | 44 +++++++++++------------- CslibTests/QueryModel/QueryExamples.lean | 11 ++---- 2 files changed, 24 insertions(+), 31 deletions(-) diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean index bd98c224e..84dca724f 100644 --- a/CslibTests/QueryModel/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -29,7 +29,7 @@ def Arith.natCost [Ring α] : Model (Arith α) ℕ where evalQuery | .add x y => x + y | .mul x y => x * y - | .neg x => -x + | .neg x => -x | .zero => 0 | .one => 1 cost _ := 1 @@ -39,23 +39,21 @@ def ex1 : Prog (Arith α) α := do let mut x : α ← @zero α let mut y ← @one α let z ← (add x y) - let w ← @neg α (←(add z y)) + let w ← @neg α (← add z y) add w z -/-- -The array version of the sort operations --/ -inductive VecSortOps (α : Type) : Type → Type where - | swap : (a : Vector α n) → (i j : Fin n) → VecSortOps α (Vector α n) - | cmp : (a : Vector α n) → (i j : Fin n) → VecSortOps α 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 array version of the sort operations. -/ +inductive VecSortOps (α : Type) : Type → Type where + | swap (a : Vector α n) (i j : Fin n) : VecSortOps α (Vector α n) + | cmp (a : Vector α n) (i j : Fin n) : VecSortOps α 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)) def VecSortOps.worstCase [DecidableEq α] : Model (VecSortOps α) ℕ where evalQuery | .write v i x => v.set i x - | .cmp l i j => l[i] == l[j] + | .cmp l i j => l[i] == l[j] | .read l i => l[i] | .swap l i j => l.swap i j | .push a elem => a.push elem @@ -79,8 +77,8 @@ def VecSortOps.cmpSwap [DecidableEq α] : Model (VecSortOps α) ℕ where | _ => 0 open VecSortOps in -def simpleExample (v : Vector ℤ n) (i k : Fin n) - : Prog (VecSortOps ℤ) (Vector ℤ (n + 1)) := do +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 @@ -91,21 +89,21 @@ inductive VecSearch (α : Type) : Type → Type where def VecSearch.nat [DecidableEq α] : Model (VecSearch α) ℕ where evalQuery - | .compare l i x => l[i]? == some x + | .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 + (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 - let cmp_res : Bool ← compare v index x - if cmp_res then - return true - else - linearSearchAux v x false (index + 1) + linearSearchAux v x false (index + 1) open VecSearch in def linearSearch (v : Vector α n) (x : α) : Prog (VecSearch α) Bool:= diff --git a/CslibTests/QueryModel/QueryExamples.lean b/CslibTests/QueryModel/QueryExamples.lean index 65140e83c..593bdf038 100644 --- a/CslibTests/QueryModel/QueryExamples.lean +++ b/CslibTests/QueryModel/QueryExamples.lean @@ -43,31 +43,26 @@ def ListOps.binSearchWorstCase [BEq α] : Model (ListOps α) ℕ where | .write l i x => l.set i x | .get l i => l[i] | .find l elem => l.findIdx (· == elem) - cost | .find l _ => 1 + Nat.log 2 (l.length) | .write l i x => l.length | .get l x => l.length inductive ArrayOps (α : Type) : Type → Type where - | get : (l : Array α) → (i : Fin l.size) → ArrayOps α α - | find : (l : Array α) → α → ArrayOps α ℕ - | write : (l : Array α) → (i : Fin l.size) → (x : α) → ArrayOps α (Array α) - + | get (l : Array α) (i : Fin l.size) : ArrayOps α α + | find (l : Array α) (x : α) : ArrayOps α ℕ + | write (l : Array α) (i : Fin l.size) (x : α) : ArrayOps α (Array α) def ArrayOps.binSearchWorstCase [BEq α] : Model (ArrayOps α) ℕ where evalQuery | .write l i x => l.set i x | .get l i => l[i] | .find l elem => l.findIdx (· == elem) - cost | .find l _ => 1 + Nat.log 2 (l.size) | .write l i x => 1 | .get l x => 1 - - end Examples end Algorithms From 022eea94a74a58db8d3b97f11c28a314e7b0139a Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Wed, 25 Feb 2026 06:51:21 +0000 Subject: [PATCH 172/176] Universe generalizations --- .../Models/ListComparisonSearch.lean | 2 +- .../Models/ListComparisonSort.lean | 4 ++-- Cslib/AlgorithmsTheory/QueryModel.lean | 2 +- CslibTests/QueryModel/ProgExamples.lean | 14 ++++++++------ CslibTests/QueryModel/QueryExamples.lean | 10 +++++----- 5 files changed, 17 insertions(+), 15 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean index 5e53f2213..888f223bc 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSearch.lean @@ -37,7 +37,7 @@ 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 +inductive ListSearch (α : Type*) : Type → Type _ where | compare (a : List α) (val : α) : ListSearch α Bool diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 952f2d106..0bd2788c4 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -119,7 +119,7 @@ section NatModel A model for comparison sorting on lists with only the comparison operation. This is used in mergeSort -/ -inductive SortOpsCmp (α : Type) : Type → Type where +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 typ. e-/ | cmpLE (x : α) (y : α) : SortOpsCmp α Bool @@ -132,7 +132,7 @@ While this accepts any decidable relation `le`, most sorting algorithms are only presence of `[Std.Total le] [IsTrans _ le]`. -/ @[simps] -def sortModelNat {α : Type} +def sortModelNat {α : Type*} (le : α → α → Prop) [DecidableRel le] : Model (SortOpsCmp α) ℕ where evalQuery | .cmpLE x y => decide (le x y) diff --git a/Cslib/AlgorithmsTheory/QueryModel.lean b/Cslib/AlgorithmsTheory/QueryModel.lean index 1a8f1dc7e..319807c05 100644 --- a/Cslib/AlgorithmsTheory/QueryModel.lean +++ b/Cslib/AlgorithmsTheory/QueryModel.lean @@ -51,7 +51,7 @@ 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 u) (Cost : Type) where +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`. diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean index 84dca724f..2665ec234 100644 --- a/CslibTests/QueryModel/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -18,7 +18,7 @@ namespace Prog section ProgExamples -inductive Arith (α : Type) : Type → Type where +inductive Arith (α : Type u) : Type u → Type _ where | add (x y : α) : Arith α α | mul (x y : α) : Arith α α | neg (x : α) : Arith α α @@ -43,9 +43,11 @@ def ex1 : Prog (Arith α) α := do add w z /-- The array version of the sort operations. -/ -inductive VecSortOps (α : Type) : Type → Type where +inductive VecSortOps.{u} (α : Type u) : Type u → Type _ where | swap (a : Vector α n) (i j : Fin n) : VecSortOps α (Vector α n) - | cmp (a : Vector α n) (i j : Fin n) : VecSortOps α Bool + -- 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)) @@ -53,7 +55,7 @@ inductive VecSortOps (α : Type) : Type → Type where def VecSortOps.worstCase [DecidableEq α] : Model (VecSortOps α) ℕ where evalQuery | .write v i x => v.set i x - | .cmp l i j => l[i] == l[j] + | .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 @@ -67,7 +69,7 @@ def VecSortOps.worstCase [DecidableEq α] : Model (VecSortOps α) ℕ where def VecSortOps.cmpSwap [DecidableEq α] : Model (VecSortOps α) ℕ where evalQuery | .write v i x => v.set i x - | .cmp l i j => l[i] == l[j] + | .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 @@ -84,7 +86,7 @@ def simpleExample (v : Vector ℤ n) (i k : Fin n) : let elem ← read c i push c elem -inductive VecSearch (α : Type) : Type → Type where +inductive VecSearch (α : Type u) : Type → Type _ where | compare (a : Vector α n) (i : ℕ) (val : α) : VecSearch α Bool def VecSearch.nat [DecidableEq α] : Model (VecSearch α) ℕ where diff --git a/CslibTests/QueryModel/QueryExamples.lean b/CslibTests/QueryModel/QueryExamples.lean index 593bdf038..390c7fca7 100644 --- a/CslibTests/QueryModel/QueryExamples.lean +++ b/CslibTests/QueryModel/QueryExamples.lean @@ -23,15 +23,15 @@ 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) : Type → Type where +inductive ListOps (α : Type u) : Type u → Type _ where | get (l : List α) (i : Fin l.length) : ListOps α α - | find (l : List α) (elem : α) : ListOps α ℕ + | find (l : List α) (elem : α) : ListOps α (ULift ℕ) | write (l : List α) (i : Fin l.length) (x : α) : ListOps α (List α) def ListOps.linSearchWorstCase [DecidableEq α] : Model (ListOps α) ℕ where evalQuery | .write l i x => l.set i x - | .find l elem => l.findIdx (· = elem) + | .find l elem => l.findIdx (· = elem) | .get l i => l[i] cost | .write l i x => l.length @@ -48,9 +48,9 @@ def ListOps.binSearchWorstCase [BEq α] : Model (ListOps α) ℕ where | .write l i x => l.length | .get l x => l.length -inductive ArrayOps (α : Type) : Type → Type where +inductive ArrayOps (α : Type u) : Type u → Type _ where | get (l : Array α) (i : Fin l.size) : ArrayOps α α - | find (l : Array α) (x : α) : ArrayOps α ℕ + | find (l : Array α) (x : α) : ArrayOps α (ULift ℕ) | write (l : Array α) (i : Fin l.size) (x : α) : ArrayOps α (Array α) def ArrayOps.binSearchWorstCase [BEq α] : Model (ArrayOps α) ℕ where From 79d8dea372425f5e172d54c8e3317209bfa28f2d Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Wed, 25 Feb 2026 06:59:31 +0000 Subject: [PATCH 173/176] deduplicate example code --- CslibTests/QueryModel/QueryExamples.lean | 45 ++++++++++++++---------- 1 file changed, 26 insertions(+), 19 deletions(-) diff --git a/CslibTests/QueryModel/QueryExamples.lean b/CslibTests/QueryModel/QueryExamples.lean index 390c7fca7..6d9b11c41 100644 --- a/CslibTests/QueryModel/QueryExamples.lean +++ b/CslibTests/QueryModel/QueryExamples.lean @@ -28,40 +28,47 @@ inductive ListOps (α : Type u) : Type u → Type _ where | 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 - | .write l i x => l.set i x - | .find l elem => l.findIdx (· = elem) - | .get l i => l[i] + evalQuery := ListOps.eval cost - | .write l i x => l.length - | .find l elem => l.length - | .get l i => l.length + | .write l _ _ => l.length + | .find l _ => l.length + | .get l _ => l.length def ListOps.binSearchWorstCase [BEq α] : Model (ListOps α) ℕ where - evalQuery - | .write l i x => l.set i x - | .get l i => l[i] - | .find l elem => l.findIdx (· == elem) + evalQuery := ListOps.eval cost | .find l _ => 1 + Nat.log 2 (l.length) - | .write l i x => l.length - | .get l x => 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 - | .write l i x => l.set i x - | .get l i => l[i] - | .find l elem => l.findIdx (· == elem) + evalQuery := ArrayOps.eval cost | .find l _ => 1 + Nat.log 2 (l.size) - | .write l i x => 1 - | .get l x => 1 + | .write _ _ _ => 1 + | .get _ _ => 1 end Examples From 163c589ad0cb31c15015f000d7639917994a1f98 Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Wed, 25 Feb 2026 07:03:11 +0000 Subject: [PATCH 174/176] style tweaks and typo --- Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean index 0bd2788c4..5aad6b123 100644 --- a/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean +++ b/Cslib/AlgorithmsTheory/Models/ListComparisonSort.lean @@ -84,11 +84,11 @@ instance : PartialOrder SortOpsCost := @[simps] instance : Add SortOpsCost where - add (soc₁ soc₂ : SortOpsCost) := ⟨soc₁.compares + soc₂.compares, soc₁.inserts + soc₂.inserts⟩ + add soc₁ soc₂ := ⟨soc₁.compares + soc₂.compares, soc₁.inserts + soc₂.inserts⟩ @[simps] instance : SMul ℕ SortOpsCost where - smul (n : ℕ) (soc : SortOpsCost) : SortOpsCost := ⟨n • soc.compares, n • soc.inserts⟩ + smul n soc := ⟨n • soc.compares, n • soc.inserts⟩ instance : AddCommMonoid SortOpsCost := fast_instance% @@ -117,11 +117,11 @@ section NatModel /-- A model for comparison sorting on lists with only the comparison operation. This -is used in mergeSort +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 typ. e-/ + The specific order relation depends on the model provided for this type. -/ | cmpLE (x : α) (y : α) : SortOpsCmp α Bool /-- From 929cf67b4cd6f9f65c1c917583bee9394c674432 Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Wed, 25 Feb 2026 08:12:37 +0000 Subject: [PATCH 175/176] further deduplicate tests --- CslibTests/QueryModel/ProgExamples.lean | 36 ++++++++++++------------- 1 file changed, 17 insertions(+), 19 deletions(-) diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean index 2665ec234..2e655f676 100644 --- a/CslibTests/QueryModel/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -52,30 +52,28 @@ inductive VecSortOps.{u} (α : Type u) : Type u → Type _ where | read (a : Vector α n) (i : Fin n) : VecSortOps α α | push (a : Vector α n) (elem : α) : VecSortOps α (Vector α (n + 1)) +/-- The typical means of evaluating a `VecSortOps`. -/ +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 + def VecSortOps.worstCase [DecidableEq α] : Model (VecSortOps α) ℕ where - evalQuery - | .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 + evalQuery := VecSortOps.eval cost - | .write l i x => 1 - | .read l i => 1 - | .cmp l i j => 1 - | .swap l i j => 1 - | .push a elem => 2 -- amortized over array insertion and resizing by doubling + | .write _ _ _ => 1 + | .read _ _ => 1 + | .cmp _ _ _ => 1 + | .swap _ _ _ => 1 + | .push _ _ => 2 -- amortized over array insertion and resizing by doubling def VecSortOps.cmpSwap [DecidableEq α] : Model (VecSortOps α) ℕ where - evalQuery - | .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 + evalQuery := VecSortOps.eval cost - | .cmp l i j => 1 - | .swap l i j => 1 + | .cmp _ _ _ => 1 + | .swap _ _ _ => 1 | _ => 0 open VecSortOps in From 4b086762c9d291ec4bc3af913446b1901de7dc24 Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Wed, 25 Feb 2026 08:16:00 +0000 Subject: [PATCH 176/176] simp in examples --- CslibTests/QueryModel/ProgExamples.lean | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CslibTests/QueryModel/ProgExamples.lean b/CslibTests/QueryModel/ProgExamples.lean index 2e655f676..18c70e985 100644 --- a/CslibTests/QueryModel/ProgExamples.lean +++ b/CslibTests/QueryModel/ProgExamples.lean @@ -53,6 +53,7 @@ inductive VecSortOps.{u} (α : Type u) : Type u → Type _ where | 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] @@ -60,6 +61,7 @@ def VecSortOps.eval [BEq α] : VecSortOps α β → β | .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 @@ -69,6 +71,7 @@ def VecSortOps.worstCase [DecidableEq α] : Model (VecSortOps α) ℕ where | .swap _ _ _ => 1 | .push _ _ => 2 -- amortized over array insertion and resizing by doubling +@[simps] def VecSortOps.cmpSwap [DecidableEq α] : Model (VecSortOps α) ℕ where evalQuery := VecSortOps.eval cost @@ -87,6 +90,7 @@ def simpleExample (v : Vector ℤ n) (i k : Fin n) : 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