From d32729a90f2c5a054b3494fe851835f20937dcd7 Mon Sep 17 00:00:00 2001 From: Marc Ilunga Date: Tue, 13 Oct 2026 13:36:08 +0100 Subject: [PATCH] Style: lemma for steps, theorem for main results Applies the convention of #18 and states it in AGENTS.md. Only keywords change. Closes #18. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01E7GPy1oUx164NSZsxJT3N9 --- AGENTS.md | 6 + src/Commons/Definitions/Cipher.lean | 2 +- src/Commons/Schemes/BlockCipher/AES.lean | 42 +-- src/Commons/Schemes/Bytes.lean | 4 +- .../Schemes/KEM/MLKEM/Concrete/Encoding.lean | 98 +++--- .../Schemes/KEM/MLKEM/Concrete/Instance.lean | 6 +- .../Schemes/KEM/MLKEM/Concrete/NTT.lean | 82 ++--- src/Commons/Schemes/KEM/MLKEM/Encoding.lean | 2 +- src/Commons/Schemes/KEM/MLKEM/KEM.lean | 4 +- src/Commons/Schemes/Lattice/Core.lean | 24 +- src/Commons/Schemes/Lattice/Kernel.lean | 10 +- src/Commons/Schemes/Lattice/NTTCert.lean | 60 ++-- src/Commons/Schemes/Lattice/Norms.lean | 52 ++-- .../Schemes/Lattice/SchoolbookCert.lean | 18 +- src/Commons/Schemes/Lattice/Transform.lean | 46 +-- .../Schemes/Lattice/VectorBackend.lean | 56 ++-- .../Schemes/Signature/MLDSA/Arithmetic.lean | 2 +- .../Signature/MLDSA/Concrete/Encoding.lean | 84 +++--- .../Signature/MLDSA/Concrete/Laws.lean | 30 +- .../Schemes/Signature/MLDSA/Concrete/NTT.lean | 78 ++--- .../Signature/MLDSA/Concrete/Rounding.lean | 72 ++--- .../Signature/MLDSA/Concrete/Sampling.lean | 54 ++-- .../Schemes/Signature/MLDSA/Scheme.lean | 6 +- .../Schemes/Signature/MLDSA/Signature.lean | 2 +- src/Commons/Schemes/Stream/CTR.lean | 10 +- src/ConstructiveCryptography/Automaton.lean | 4 +- .../Construction/Basic.lean | 8 +- src/ConstructiveCryptography/Context.lean | 14 +- .../ConverterCoherence.lean | 14 +- .../CryptographicAlgebra/Basic.lean | 40 +-- .../CryptographicAlgebra/Distinguisher.lean | 4 +- .../CryptographicAlgebra/Epsilon.lean | 18 +- .../CryptographicAlgebra/Game.lean | 8 +- .../CryptographicAlgebra/PseudoMetric.lean | 32 +- .../CryptographicAlgebra/Relaxation.lean | 10 +- .../CryptographicAlgebra/Star.lean | 20 +- .../DDCCoherence.lean | 12 +- .../DSL/Converters.lean | 10 +- .../DSL/Programs.lean | 36 +-- src/ConstructiveCryptography/Functional.lean | 14 +- src/ConstructiveCryptography/Interface.lean | 12 +- .../InterfaceAlgebra.lean | 24 +- .../InterfaceCoherence.lean | 14 +- .../InterfaceFilter.lean | 4 +- .../InterfaceGame.lean | 2 +- .../InterfaceMonoidal.lean | 16 +- .../InterfaceParallel.lean | 8 +- .../InterfaceRelabel.lean | 10 +- .../InterfaceTensorRename.lean | 10 +- src/ConstructiveCryptography/Notation.lean | 12 +- .../PresentedGame.lean | 10 +- .../ResourceCoherence.lean | 22 +- .../ResourceParallel.lean | 6 +- .../ResourceParallelAttachment.lean | 2 +- src/ConstructiveCryptography/Source.lean | 2 +- .../Specification/Game.lean | 6 +- .../Specification/Game/Basic.lean | 6 +- .../Specification/Maps.lean | 10 +- .../Specification/Metric.lean | 6 +- .../Specification/Relaxation/Basic.lean | 10 +- .../Specification/Relaxation/Defs.lean | 8 +- .../Specification/Relaxation/Epsilon.lean | 2 +- .../Specification/Relaxation/Kernel.lean | 4 +- .../Specification/Star.lean | 6 +- .../Specification/Star/Metric.lean | 2 +- .../Substitution/Basic.lean | 8 +- .../Substitution/Implication.lean | 10 +- .../Substitution/Quantitative.lean | 4 +- .../Substitution/Reduction.lean | 14 +- .../Substitution/Relaxation.lean | 16 +- .../AuthenticatedEncryption/Collision.lean | 34 +-- .../AuthenticatedEncryption/Hybrid.lean | 26 +- .../AuthenticatedEncryption/Oracle.lean | 52 ++-- .../AuthenticatedEncryption/Security.lean | 4 +- src/Examples/DSL/AEAD.lean | 2 +- src/Examples/DSL/AEADTests.lean | 14 +- src/Examples/DSL/AES.lean | 10 +- src/Examples/Games.lean | 4 +- src/Examples/Substitution.lean | 2 +- src/Probability/Counting.lean | 36 +-- src/Probability/Coupling.lean | 48 +-- src/Probability/Distribution.lean | 232 +++++++-------- src/Probability/Expectation.lean | 52 ++-- src/Probability/Lift.lean | 30 +- src/Probability/MultiCoupling.lean | 46 +-- src/Probability/StatisticalDistance.lean | 36 +-- .../Converter/ConverterAttachment.lean | 20 +- .../Converter/ConverterDomain.lean | 84 +++--- .../Converter/ConverterRelabel.lean | 24 +- .../Converter/ConverterTensor.lean | 62 ++-- .../Converter/EmptyInterface.lean | 18 +- .../Converter/FilterAttachment.lean | 14 +- src/RandomSystems/Converter/Identity.lean | 20 +- src/RandomSystems/Converter/PDCBehavior.lean | 32 +- src/RandomSystems/Converter/ParallelPDS.lean | 14 +- .../Converter/PartialConverter.lean | 6 +- .../Converter/PartialIdentity.lean | 22 +- src/RandomSystems/Converter/Program.lean | 56 ++-- .../Converter/ProgramAttachment.lean | 48 +-- .../Converter/ResourceAttachment.lean | 38 +-- .../Converter/ResourceCanon.lean | 8 +- .../Cumulative/ConnectionObservation.lean | 52 ++-- src/RandomSystems/Cumulative/Cumulative.lean | 52 ++-- .../Cumulative/CumulativeAttachment.lean | 6 +- .../Cumulative/CumulativeObservation.lean | 50 ++-- .../Cumulative/CumulativeOperations.lean | 26 +- .../Cumulative/Presentation.lean | 26 +- .../Cumulative/Subprobability.lean | 20 +- src/RandomSystems/DDC/Absorb.lean | 26 +- src/RandomSystems/DDC/CanonWiring.lean | 6 +- src/RandomSystems/DDC/DDC.lean | 88 +++--- src/RandomSystems/DDC/DDCParallelLaws.lean | 12 +- src/RandomSystems/DDC/DDCRelabel.lean | 40 +-- src/RandomSystems/DDC/Serial.lean | 64 ++-- src/RandomSystems/DDC/SingleAlphabet.lean | 22 +- src/RandomSystems/DDC/Tensor.lean | 90 +++--- src/RandomSystems/Distance/Absorption.lean | 16 +- src/RandomSystems/Distance/Coupling.lean | 10 +- src/RandomSystems/Distance/Decision.lean | 36 +-- src/RandomSystems/Distance/Distinguisher.lean | 28 +- .../Distance/ParallelObservation.lean | 12 +- src/RandomSystems/Distance/Restriction.lean | 18 +- src/RandomSystems/Distance/Transcript.lean | 40 +-- src/RandomSystems/Distance/UntilBad.lean | 4 +- src/RandomSystems/Game/DiscreteMBO.lean | 28 +- src/RandomSystems/Game/FunctionGame.lean | 8 +- src/RandomSystems/Game/MBO.lean | 52 ++-- src/RandomSystems/Game/MBOAttachment.lean | 144 ++++----- src/RandomSystems/Game/UntilBad.lean | 4 +- src/RandomSystems/PDS/Conditional.lean | 20 +- src/RandomSystems/PDS/Filter.lean | 18 +- src/RandomSystems/PDS/Function.lean | 6 +- src/RandomSystems/PDS/PDS.lean | 28 +- src/RandomSystems/System/Automaton.lean | 18 +- src/RandomSystems/System/Basic.lean | 280 +++++++++--------- src/RandomSystems/System/InterfaceSystem.lean | 124 ++++---- src/RandomSystems/System/Observation.lean | 74 ++--- src/RandomSystems/System/Replies.lean | 40 +-- src/Tests/AuthenticatedEncryption.lean | 10 +- src/Tests/Counterexamples.lean | 6 +- src/Tests/DSL/Semantics.lean | 22 +- src/Tests/Substitution/Calculation.lean | 4 +- src/Tests/Substitution/Construction.lean | 4 +- src/Tests/Substitution/Implication.lean | 4 +- src/Tests/Substitution/Quantitative.lean | 2 +- src/Tests/Substitution/Relaxation.lean | 4 +- src/Tests/Substitution/Tactics.lean | 8 +- 147 files changed, 2056 insertions(+), 2050 deletions(-) diff --git a/AGENTS.md b/AGENTS.md index 2780843..e6d7b31 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -248,6 +248,12 @@ globally; use `letI` or a wrapper carrier. the distances are defined from real probabilities (`transcriptDistance`, the advantages, `advantageDistance`) and in the lemmas that bridge to them (`transcriptDistance_le`, `transcriptDistance_le_of_advantage_le`). +- `theorem` marks the results a reader comes for; `lemma` marks everything else. A `theorem` + states a source result, and its docstring cites it (`[1, Lemma 4.16]`, CR18, Lemma 4.15), or + it is one of the few headline results of its module that have no source: a correctness + theorem, a security bound, the law the module exists to prove. Steps, helpers, rewriting + lemmas and typed corollaries are `lemma`, even when the module doc lists them. Both keywords + elaborate the same way; the choice is documentation only. ## Naming and ownership diff --git a/src/Commons/Definitions/Cipher.lean b/src/Commons/Definitions/Cipher.lean index 270fbe8..a3d9710 100644 --- a/src/Commons/Definitions/Cipher.lean +++ b/src/Commons/Definitions/Cipher.lean @@ -49,7 +49,7 @@ def BlockCipher.perm [Finite X] (E : BlockCipher K X) (k : K) : Equiv.Perm X := rw [E.decrypt_encrypt] } /-- Encryption inverts decryption. -/ -theorem BlockCipher.encrypt_decrypt [Finite X] (E : BlockCipher K X) (k : K) (y : X) : +lemma BlockCipher.encrypt_decrypt [Finite X] (E : BlockCipher K X) (k : K) (y : X) : E.encrypt k (E.decrypt k y) = y := (E.perm k).right_inv y diff --git a/src/Commons/Schemes/BlockCipher/AES.lean b/src/Commons/Schemes/BlockCipher/AES.lean index 558721f..bd39d16 100644 --- a/src/Commons/Schemes/BlockCipher/AES.lean +++ b/src/Commons/Schemes/BlockCipher/AES.lean @@ -75,13 +75,13 @@ def mul (b c : UInt8) : UInt8 := (List.range 8).foldr (fun i acc => if (b >>> i.toUInt8) &&& 1 = 0 then acc else xTimes^[i] c ^^^ acc) 0 -theorem shiftRight_seven (b : UInt8) : b >>> 7 = 0 ∨ b >>> 7 = 1 := by +lemma shiftRight_seven (b : UInt8) : b >>> 7 = 0 ∨ b >>> 7 = 1 := by obtain ⟨i, rfl⟩ : ∃ i : Fin 256, UInt8.ofFin i = b := ⟨b.toFin, rfl⟩ revert i decide +kernel /-- `xTimes` is linear. -/ -theorem xTimes_xor (x y : UInt8) : xTimes (x ^^^ y) = xTimes x ^^^ xTimes y := by +lemma xTimes_xor (x y : UInt8) : xTimes (x ^^^ y) = xTimes x ^^^ xTimes y := by unfold xTimes rw [UInt8.shiftRight_xor, UInt8.shiftLeft_xor] rcases shiftRight_seven x with hx | hx <;> rcases shiftRight_seven y with hy | hy <;> @@ -91,14 +91,14 @@ theorem xTimes_xor (x y : UInt8) : xTimes (x ^^^ y) = xTimes x ^^^ xTimes y := b | rw [UInt8.xor_assoc, UInt8.xor_comm (y <<< 1) 27, ← UInt8.xor_assoc 27 27, UInt8.xor_self, UInt8.zero_xor] -theorem iterate_xTimes_xor (n : ℕ) (x y : UInt8) : +lemma iterate_xTimes_xor (n : ℕ) (x y : UInt8) : xTimes^[n] (x ^^^ y) = xTimes^[n] x ^^^ xTimes^[n] y := by induction n generalizing x y with | zero => rfl | succ n ih => simp only [Function.iterate_succ_apply, xTimes_xor, ih] /-- Multiplication in GF(2⁸) is linear. -/ -theorem mul_xor (b x y : UInt8) : mul b (x ^^^ y) = mul b x ^^^ mul b y := by +lemma mul_xor (b x y : UInt8) : mul b (x ^^^ y) = mul b x ^^^ mul b y := by unfold mul induction List.range 8 with | nil => simp @@ -158,7 +158,7 @@ def invSbox (b : UInt8) : UInt8 := (invSboxTable[b.toNat / 16]'(by have := b.toNat_lt; omega))[b.toNat % 16]'(by omega) /-- The inverse S-box inverts the S-box. -/ -theorem invSbox_sbox (b : UInt8) : invSbox (sbox b) = b := by +lemma invSbox_sbox (b : UInt8) : invSbox (sbox b) = b := by obtain ⟨i, rfl⟩ : ∃ i : Fin 256, UInt8.ofFin i = b := ⟨b.toFin, rfl⟩ revert i decide +kernel @@ -258,14 +258,14 @@ def invCipher (k : KeyLength) (key : Key k) (input : Block) : Block := /-! ## The inverse cipher inverts the cipher -/ -theorem addRoundKey_addRoundKey (s : Block) (w : Array Word) (round : ℕ) : +lemma addRoundKey_addRoundKey (s : Block) (w : Array Word) (round : ℕ) : addRoundKey (addRoundKey s w round) w round = s := xor_cancel_right _ _ -theorem invSubBytes_subBytes (s : Block) : invSubBytes (subBytes s) = s := +lemma invSubBytes_subBytes (s : Block) : invSubBytes (subBytes s) = s := Vector.ext fun i hi => by simp [invSubBytes, subBytes, invSbox_sbox] -theorem invShiftRows_shiftRows (s : Block) : invShiftRows (shiftRows s) = s := +lemma invShiftRows_shiftRows (s : Block) : invShiftRows (shiftRows s) = s := Vector.ext fun i hi => by interval_cases i <;> simp [invShiftRows, shiftRows] @@ -273,13 +273,13 @@ theorem invShiftRows_shiftRows (s : Block) : invShiftRows (shiftRows s) = s := def bit (j : ℕ) : UInt8 := 1 <<< j.toUInt8 /-- A byte is the sum of its bits. -/ -theorem eq_xor_bits (x : UInt8) : +lemma eq_xor_bits (x : UInt8) : x = (List.range 8).foldr (fun j acc => (x &&& bit j) ^^^ acc) 0 := by obtain ⟨i, rfl⟩ : ∃ i : Fin 256, UInt8.ofFin i = x := ⟨x.toFin, rfl⟩ revert i decide +kernel -theorem and_bit (x : UInt8) (j : ℕ) (hj : j < 8) : +lemma and_bit (x : UInt8) (j : ℕ) (hj : j < 8) : x &&& bit j = 0 ∨ x &&& bit j = bit j := by obtain ⟨i, rfl⟩ : ∃ i : Fin 256, UInt8.ofFin i = x := ⟨x.toFin, rfl⟩ obtain ⟨j, rfl⟩ : ∃ j' : Fin 8, j'.val = j := ⟨⟨j, hj⟩, rfl⟩ @@ -288,7 +288,7 @@ theorem and_bit (x : UInt8) (j : ℕ) (hj : j < 8) : /-- **Linear maps of bytes are determined by the bits**: two maps from bytes to words that preserve `^^^` and agree on each bit agree. -/ -theorem eq_of_xor_of_bits {f g : UInt8 → Word} (hf : ∀ x y, f (x ^^^ y) = f x ^^^ f y) +lemma eq_of_xor_of_bits {f g : UInt8 → Word} (hf : ∀ x y, f (x ^^^ y) = f x ^^^ f y) (hg : ∀ x y, g (x ^^^ y) = g x ^^^ g y) (hbits : ∀ j < 8, f (bit j) = g (bit j)) (x : UInt8) : f x = g x := by have zero : ∀ {h : UInt8 → Word}, (∀ x y, h (x ^^^ y) = h x ^^^ h y) → h 0 = 0 := by @@ -313,34 +313,34 @@ theorem eq_of_xor_of_bits {f g : UInt8 → Word} (hf : ∀ x y, f (x ^^^ y) = f /-- The single-byte column `x` at row `r`. -/ def singleton (r : Fin 4) (x : UInt8) : Word := Vector.ofFn fun r' => if r' = r then x else 0 -theorem singleton_xor (r : Fin 4) (x y : UInt8) : +lemma singleton_xor (r : Fin 4) (x y : UInt8) : singleton r (x ^^^ y) = singleton r x ^^^ singleton r y := Vector.ext fun i hi => by simp only [singleton, Vector.getElem_ofFn, Bytes.getElem_xor] split_ifs <;> simp -theorem mixColumn_xor (a b : Word) : mixColumn (a ^^^ b) = mixColumn a ^^^ mixColumn b := +lemma mixColumn_xor (a b : Word) : mixColumn (a ^^^ b) = mixColumn a ^^^ mixColumn b := Vector.ext fun i hi => by interval_cases i <;> simp [mixColumn, mul_xor] <;> ac_rfl -theorem invMixColumn_xor (a b : Word) : +lemma invMixColumn_xor (a b : Word) : invMixColumn (a ^^^ b) = invMixColumn a ^^^ invMixColumn b := Vector.ext fun i hi => by interval_cases i <;> simp [invMixColumn, mul_xor] <;> ac_rfl -theorem word_eq_singletons (a : Word) : +lemma word_eq_singletons (a : Word) : a = singleton 0 a[0] ^^^ singleton 1 a[1] ^^^ singleton 2 a[2] ^^^ singleton 3 a[3] := Vector.ext fun i hi => by interval_cases i <;> simp [singleton] -theorem invMixColumn_mixColumn_bits : +lemma invMixColumn_mixColumn_bits : ∀ r : Fin 4, ∀ j : Fin 8, invMixColumn (mixColumn (singleton r (bit j.val))) = singleton r (bit j.val) := by decide +kernel /-- **`INVMIXCOLUMNS` inverts `MIXCOLUMNS` on a column**: both are linear, so it suffices that each bit of each byte of a column is inverted. -/ -theorem invMixColumn_mixColumn (a : Word) : invMixColumn (mixColumn a) = a := by +lemma invMixColumn_mixColumn (a : Word) : invMixColumn (mixColumn a) = a := by have hbyte : ∀ r x, invMixColumn (mixColumn (singleton r x)) = singleton r x := fun r => eq_of_xor_of_bits (f := fun x => invMixColumn (mixColumn (singleton r x))) (fun x y => by simp only [singleton_xor, mixColumn_xor, invMixColumn_xor]) @@ -348,23 +348,23 @@ theorem invMixColumn_mixColumn (a : Word) : invMixColumn (mixColumn a) = a := by rw [word_eq_singletons a] simp only [mixColumn_xor, invMixColumn_xor, hbyte] -theorem column_ofColumns (columns : Vector Word 4) (c : Fin 4) : +lemma column_ofColumns (columns : Vector Word 4) (c : Fin 4) : column (ofColumns columns) c = columns[c] := Vector.ext fun r hr => by fin_cases c <;> interval_cases r <;> simp [column, ofColumns] -theorem ofColumns_column (s : Block) : ofColumns (Vector.ofFn fun c => column s c) = s := +lemma ofColumns_column (s : Block) : ofColumns (Vector.ofFn fun c => column s c) = s := Vector.ext fun i hi => by interval_cases i <;> simp [ofColumns, column] -theorem invMixColumns_mixColumns (s : Block) : invMixColumns (mixColumns s) = s := by +lemma invMixColumns_mixColumns (s : Block) : invMixColumns (mixColumns s) = s := by simp only [invMixColumns, mixColumns, column_ofColumns, Fin.getElem_fin, Vector.getElem_ofFn, invMixColumn_mixColumn, Fin.eta, ofColumns_column] /-- **The inverse rounds invert the rounds**: after `SubBytes` and `ShiftRows`, the inverse rounds in the reverse order undo the rounds `rs`, the inverse of round `r` undoing `MixColumns` and `AddRoundKey` of round `r` and `SubBytes` and `ShiftRows` of the round before. -/ -theorem invRounds_rounds (w : Array Word) (rs : List ℕ) (s : Block) : +lemma invRounds_rounds (w : Array Word) (rs : List ℕ) (s : Block) : rs.reverse.foldl (fun state round => invMixColumns (addRoundKey (invSubBytes (invShiftRows state)) w round)) (shiftRows (subBytes (rs.foldl (fun state round => diff --git a/src/Commons/Schemes/Bytes.lean b/src/Commons/Schemes/Bytes.lean index 1ff986e..b57c35b 100644 --- a/src/Commons/Schemes/Bytes.lean +++ b/src/Commons/Schemes/Bytes.lean @@ -50,12 +50,12 @@ instance {n : ℕ} : XorOp (Bytes n) := ⟨Bytes.xor⟩ instance {n : ℕ} : Zero (Bytes n) := ⟨Vector.replicate n 0⟩ -@[simp] theorem Bytes.getElem_xor {n : ℕ} (a b : Bytes n) (i : ℕ) (hi : i < n) : +@[simp] lemma Bytes.getElem_xor {n : ℕ} (a b : Bytes n) (i : ℕ) (hi : i < n) : (a ^^^ b)[i] = a[i] ^^^ b[i] := by change (Vector.zipWith (· ^^^ ·) a b)[i] = _ simp -@[simp] theorem Bytes.getElem_zero {n : ℕ} (i : ℕ) (hi : i < n) : (0 : Bytes n)[i] = 0 := by +@[simp] lemma Bytes.getElem_zero {n : ℕ} (i : ℕ) (hi : i < n) : (0 : Bytes n)[i] = 0 := by change (Vector.replicate n 0)[i] = _ simp diff --git a/src/Commons/Schemes/KEM/MLKEM/Concrete/Encoding.lean b/src/Commons/Schemes/KEM/MLKEM/Concrete/Encoding.lean index f50a435..0eee9c1 100644 --- a/src/Commons/Schemes/KEM/MLKEM/Concrete/Encoding.lean +++ b/src/Commons/Schemes/KEM/MLKEM/Concrete/Encoding.lean @@ -30,7 +30,7 @@ def bitOf (b : UInt8) (j : Nat) : Nat := def packByte (bits : Fin 8 → Nat) : UInt8 := (Nat.ofDigits 2 (List.ofFn bits)).toUInt8 -theorem bitOf_packByte_fin : +lemma bitOf_packByte_fin : ∀ bits : Fin 8 → Fin 2, ∀ j : Fin 8, bitOf (packByte fun i => (bits i).val) j.val = (bits j).val := by intro bits j @@ -57,33 +57,33 @@ theorem bitOf_packByte_fin : Nat.ofDigits_div_pow_eq_ofDigits_drop j.val (by norm_num) digits hdigits, Nat.ofDigits_mod_eq_head!, hhead, Nat.mod_eq_of_lt (bits j).isLt] -theorem bitOf_lt_two (b : UInt8) (j : Nat) : bitOf b j < 2 := by +lemma bitOf_lt_two (b : UInt8) (j : Nat) : bitOf b j < 2 := by unfold bitOf rw [UInt8.toNat_and, show (1 : UInt8).toNat = 1 from rfl, show (2 : ℕ) = 2 ^ 1 from rfl] exact Nat.and_lt_two_pow _ (by norm_num) -theorem bitOf_lt_two_fin_aux : +lemma bitOf_lt_two_fin_aux : ∀ n : Fin (2 ^ 8), ∀ j : Fin 8, bitOf n.val.toUInt8 j.val < 2 := by intro _ _; exact bitOf_lt_two _ _ -theorem bitOf_lt_two_fin (b : UInt8) (j : Fin 8) : bitOf b j.val < 2 := +lemma bitOf_lt_two_fin (b : UInt8) (j : Fin 8) : bitOf b j.val < 2 := bitOf_lt_two b j.val -theorem packByte_bitOf_fin : +lemma packByte_bitOf_fin : ∀ n : Fin (2 ^ 8), packByte (fun j => bitOf n.val.toUInt8 j.val) = n.val.toUInt8 := by intro n; fin_cases n <;> rfl -theorem packByte_bitOf_byte (b : UInt8) : +lemma packByte_bitOf_byte (b : UInt8) : packByte (fun j => bitOf b j.val) = b := by simpa using packByte_bitOf_fin ⟨b.toNat, UInt8.toNat_lt b⟩ -theorem array_getD_eq_getElem {α : Type} (a : Array α) {i : Nat} +lemma array_getD_eq_getElem {α : Type} (a : Array α) {i : Nat} {fallback : α} (hi : i < a.size) : a.getD i fallback = a[i] := by simp [Array.getD, hi] -theorem array_getD_eq_fallback {α : Type} (a : Array α) {i : Nat} +lemma array_getD_eq_fallback {α : Type} (a : Array α) {i : Nat} {fallback : α} (hi : ¬i < a.size) : a.getD i fallback = fallback := by simp [Array.getD, hi] @@ -108,21 +108,21 @@ def bytesToBits (bytes : ByteArray) : Array Nat := exact Nat.div_lt_of_lt_mul this bitOf (bytes[byteIdx]'hbyte) bitIdx -theorem bitsToBytes_size (bits : Array Nat) : +lemma bitsToBytes_size (bits : Array Nat) : (bitsToBytes bits).size = bits.size / 8 := by simp [bitsToBytes] -theorem bitsToBytes_getElem (bits : Array Nat) (i : Nat) +lemma bitsToBytes_getElem (bits : Array Nat) (i : Nat) (hi : i < (bitsToBytes bits).size) : (bitsToBytes bits)[i]'hi = packByte fun j => bits.getD (8 * i + j.val) 0 := by simp only [bitsToBytes, ByteArray.getElem_ofFn] -theorem bytesToBits_size (bytes : ByteArray) : +lemma bytesToBits_size (bytes : ByteArray) : (bytesToBits bytes).size = bytes.size * 8 := by simp [bytesToBits] -theorem bytesToBits_getElem (bytes : ByteArray) (i : Nat) +lemma bytesToBits_getElem (bytes : ByteArray) (i : Nat) (hi : i < (bytesToBits bytes).size) : (bytesToBits bytes)[i]'hi = bitOf (bytes[i / 8]'(Nat.div_lt_of_lt_mul (by @@ -130,7 +130,7 @@ theorem bytesToBits_getElem (bytes : ByteArray) (i : Nat) simpa [Nat.mul_comm] using this))) (i % 8) := by simp only [bytesToBits, Array.getElem_ofFn] -theorem bytesToBits_bitsToBytes_getElem {bits : Array Nat} {i : Nat} +lemma bytesToBits_bitsToBytes_getElem {bits : Array Nat} {i : Nat} (hsize : bits.size % 8 = 0) (hbits : ∀ j, j < bits.size → bits.getD j 0 < 2) (hi : i < bits.size) : @@ -170,7 +170,7 @@ theorem bytesToBits_bitsToBytes_getElem {bits : Array Nat} {i : Nat} rw [hpacked, hindex] simp [hi] -theorem bitsToBytes_bytesToBits (bytes : ByteArray) : +lemma bitsToBytes_bytesToBits (bytes : ByteArray) : bitsToBytes (bytesToBits bytes) = bytes := by apply ByteArray.ext_getElem · simp [bitsToBytes, bytesToBits] @@ -205,7 +205,7 @@ theorem bitsToBytes_bytesToBits (bytes : ByteArray) : simpa using congrArg packByte hbitsEq rw [hpack, packByte_bitOf_byte] -theorem bytesToBits_getD_lt_two (bytes : ByteArray) (i : Nat) : +lemma bytesToBits_getD_lt_two (bytes : ByteArray) (i : Nat) : (bytesToBits bytes).getD i 0 < 2 := by by_cases hi : i < (bytesToBits bytes).size · rw [array_getD_eq_getElem (a := bytesToBits bytes) (i := i) (fallback := 0) hi] @@ -225,21 +225,21 @@ theorem bytesToBits_getD_lt_two (bytes : ByteArray) (i : Nat) : · rw [array_getD_eq_fallback (bytesToBits bytes) hi] norm_num -theorem ofDigits_digitsAppend_two {d n : Nat} (hn : n < 2 ^ d) : +lemma ofDigits_digitsAppend_two {d n : Nat} (hn : n < 2 ^ d) : Nat.ofDigits 2 (Nat.digitsAppend 2 d n) = n := by simpa using (Nat.setInvOn_digitsAppend_ofDigits (b := 2) (by norm_num) d).2 hn -theorem digitsAppend_getD_two_lt {d n bit : Nat} (hn : n < 2 ^ d) (hbit : bit < d) : +lemma digitsAppend_getD_two_lt {d n bit : Nat} (hn : n < 2 ^ d) (hbit : bit < d) : (Nat.digitsAppend 2 d n).getD bit 0 < 2 := by rw [List.getD_eq_getElem _ _ (by simpa [Nat.length_digitsAppend (by norm_num) d hn] using hbit)] exact Nat.lt_of_mem_digitsAppend (by norm_num) d _ (List.getElem_mem _) -theorem digitsAppend_two_one_getD_zero : +lemma digitsAppend_two_one_getD_zero : ∀ n : Fin 2, (Nat.digitsAppend 2 1 n.val).getD 0 0 = n.val := by intro n fin_cases n <;> rfl -theorem digitsAppend_two_one_getD_zero_mod (n : Nat) : +lemma digitsAppend_two_one_getD_zero_mod (n : Nat) : (Nat.digitsAppend 2 1 (n % 2 ^ 1)).getD 0 0 = n % 2 := by simpa [Nat.pow_one] using digitsAppend_two_one_getD_zero ⟨n % 2, Nat.mod_lt _ (by norm_num)⟩ @@ -272,7 +272,7 @@ def byteDecode (d : Nat) (bytes : ByteArray) : Rq := ((Nat.ofDigits 2 coeffBits : Nat) : Coeff) /-- `byteEncode d` always produces exactly `32 * d` bytes (FIPS 203 Algorithm 5). -/ -theorem byteEncode_size (d : Nat) (f : Rq) : +lemma byteEncode_size (d : Nat) (f : Rq) : (byteEncode d f).size = 32 * d := by let bits : Array Nat := Array.ofFn fun idx : Fin (ringDegree * d) => let coeff := idx.val / d @@ -296,7 +296,7 @@ theorem byteEncode_size (d : Nat) (f : Rq) : simp [ringDegree] omega -theorem byteDecode_byteEncode_of_bound {d : Nat} (hd : 0 < d) (f : Rq) +lemma byteDecode_byteEncode_of_bound {d : Nat} (hd : 0 < d) (f : Rq) (hbound : ∀ idx : Fin ringDegree, ((f[idx.val] : Coeff).val) < 2 ^ d) : byteDecode d (byteEncode d f) = f := by let bits : Array Nat := Array.ofFn fun idx : Fin (ringDegree * d) => @@ -433,7 +433,7 @@ theorem byteDecode_byteEncode_of_bound {d : Nat} (hd : 0 < d) (f : Rq) rw [hcoeffBits, hdigits, ofDigits_digitsAppend_two hcoeffBound] exact ZMod.natCast_zmod_val (f[i]) -theorem byteDecode_one_coeff (bytes : ByteArray) (idx : Fin ringDegree) : +lemma byteDecode_one_coeff (bytes : ByteArray) (idx : Fin ringDegree) : ((byteDecode 1 bytes).get idx : Coeff).val = (bytesToBits bytes).getD idx.val 0 := by have hbitMod : (bytesToBits bytes).getD idx.val 0 < modulus := lt_trans (bytesToBits_getD_lt_two bytes idx.val) (by norm_num [modulus]) @@ -503,20 +503,20 @@ def byteDecode12VecPoly {k : Nat} (bytes : ByteArray) (poly : Fin k) : Tq := else ((b1 / 16 + 16 * b2 : Nat) : Coeff)⟩ -theorem decode12Pair_fst {a b : Nat} (ha : a < 4096) : +lemma decode12Pair_fst {a b : Nat} (ha : a < 4096) : a % 256 + 256 * ((a / 256 + 16 * (b % 16)) % 16) = a := by omega -theorem decode12Pair_snd {a b : Nat} (ha : a < 4096) : +lemma decode12Pair_snd {a b : Nat} (ha : a < 4096) : (a / 256 + 16 * (b % 16)) / 16 + 16 * (b / 16) = b := by omega -theorem getByteD_eq_getElem {bytes : ByteArray} {i : Nat} (hi : i < bytes.size) : +lemma getByteD_eq_getElem {bytes : ByteArray} {i : Nat} (hi : i < bytes.size) : getByteD bytes i = bytes[i] := by unfold getByteD simp [hi] -theorem getByteD_byteEncode12Poly (f : Tq) {j : Nat} (hj : j < 384) : +lemma getByteD_byteEncode12Poly (f : Tq) {j : Nat} (hj : j < 384) : getByteD (byteEncode12Poly f) j = byteEncode12PolyByte f ⟨j, hj⟩ := by have hsizeData : j < (byteEncode12Poly f).data.size := by simpa [byteEncode12Poly] using hj @@ -526,7 +526,7 @@ theorem getByteD_byteEncode12Poly (f : Tq) {j : Nat} (hj : j < 384) : rw [ByteArray.getElem_eq_getElem_data] simp [byteEncode12Poly] -theorem tq_getElem_eq_coeffs (f : Tq) {i : Nat} (hi : i < ringDegree) : +lemma tq_getElem_eq_coeffs (f : Tq) {i : Nat} (hi : i < ringDegree) : f[i] = f.coeffs[i] := rfl /-- Encode a vector of `k` polynomials with 12-bit coefficients. -/ @@ -534,11 +534,11 @@ def byteEncode12Vec {k : Nat} (v : TqVec k) : ByteArray := ByteArray.mk <| Array.ofFn (byteEncode12VecByte v) /-- The 12-bit packing of `k` NTT-domain polynomials occupies exactly `384 * k` bytes. -/ -theorem byteEncode12Vec_size {k : Nat} (v : TqVec k) : +lemma byteEncode12Vec_size {k : Nat} (v : TqVec k) : (byteEncode12Vec v).size = 384 * k := by simp [byteEncode12Vec, ByteArray.size] -theorem getByteD_byteEncode12Vec {k : Nat} (v : TqVec k) {poly j : Nat} +lemma getByteD_byteEncode12Vec {k : Nat} (v : TqVec k) {poly j : Nat} (hpoly : poly < k) (hj : j < 384) : getByteD (byteEncode12Vec v) (poly * 384 + j) = byteEncode12PolyByte (v[poly]'hpoly) ⟨j, hj⟩ := by @@ -562,7 +562,7 @@ def byteDecode12Vec (k : Nat) (bytes : ByteArray) : TqVec k := Vector.ofFn fun idx => byteDecode12VecPoly bytes idx -theorem byteDecode12Poly_byteEncode12Poly (f : Tq) : +lemma byteDecode12Poly_byteEncode12Poly (f : Tq) : byteDecode12Poly (byteEncode12Poly f) = f := by have hfun : (fun idx : Fin ringDegree => @@ -683,14 +683,14 @@ theorem byteDecode12Poly_byteEncode12Poly (f : Tq) : rw [Array.getElem_ofFn] exact (Vector.getElem_toArray hi2).symm -theorem getByteD_byteEncode12Vec_eq_byteEncode12Poly +lemma getByteD_byteEncode12Vec_eq_byteEncode12Poly {k : Nat} (v : TqVec k) {poly j : Nat} (hpoly : poly < k) (hj : j < 384) : getByteD (byteEncode12Vec v) (poly * 384 + j) = getByteD (byteEncode12Poly (v[poly]'hpoly)) j := by rw [getByteD_byteEncode12Vec (v := v) hpoly hj, getByteD_byteEncode12Poly (f := v[poly]'hpoly) hj] -theorem byteDecode12VecPoly_byteEncode12Vec_eq {k : Nat} (v : TqVec k) (poly : Fin k) : +lemma byteDecode12VecPoly_byteEncode12Vec_eq {k : Nat} (v : TqVec k) (poly : Fin k) : byteDecode12VecPoly (byteEncode12Vec v) poly = byteDecode12Poly (byteEncode12Poly (v[poly.val])) := by have hfun : @@ -734,7 +734,7 @@ theorem byteDecode12VecPoly_byteEncode12Vec_eq {k : Nat} (v : TqVec k) (poly : F rw [Vector.toArray_ofFn, Vector.toArray_ofFn] exact congrArg Array.ofFn hfun -theorem byteDecode12Vec_byteEncode12Vec {k : Nat} (v : TqVec k) : +lemma byteDecode12Vec_byteEncode12Vec {k : Nat} (v : TqVec k) : byteDecode12Vec k (byteEncode12Vec v) = v := by have hfun : (fun idx : Fin k => byteDecode12VecPoly (byteEncode12Vec v) idx) @@ -776,7 +776,7 @@ def byteEncodeVec (d : Nat) {k : Nat} (v : RqVec k) : ByteArray := getByteD (byteEncode d (v[poly]'hpoly)) byte /-- Encoding `k` polynomials with `d`-bit coefficients occupies exactly `32 * d * k` bytes. -/ -theorem byteEncodeVec_size (d : Nat) {k : Nat} (v : RqVec k) : +lemma byteEncodeVec_size (d : Nat) {k : Nat} (v : RqVec k) : (byteEncodeVec d v).size = 32 * d * k := by simp [byteEncodeVec, ByteArray.size] @@ -788,7 +788,7 @@ def byteDecodeVec (d k : Nat) (bytes : ByteArray) : RqVec k := Array.ofFn fun j : Fin chunkSize => getByteD bytes (idx.val * chunkSize + j.val) -theorem getByteD_byteEncodeVec {d k : Nat} (hd : 0 < d) (v : RqVec k) +lemma getByteD_byteEncodeVec {d k : Nat} (hd : 0 < d) (v : RqVec k) {poly j : Nat} (hpoly : poly < k) (hj : j < 32 * d) : getByteD (byteEncodeVec d v) (poly * (32 * d) + j) = getByteD (byteEncode d (v[poly]'hpoly)) j := by @@ -821,7 +821,7 @@ theorem getByteD_byteEncodeVec {d k : Nat} (hd : 0 < d) (v : RqVec k) · exact False.elim (hd.ne' hzero) · simp [hzero, hdiv, hmod] -theorem byteDecodeVec_byteEncodeVec_of_bound {d k : Nat} (hd : 0 < d) (v : RqVec k) +lemma byteDecodeVec_byteEncodeVec_of_bound {d k : Nat} (hd : 0 < d) (v : RqVec k) (hbound : ∀ poly : Fin k, ∀ coeff : Fin ringDegree, (((v[poly.val]'poly.isLt)[coeff.val] : Coeff).val) < 2 ^ d) : byteDecodeVec d k (byteEncodeVec d v) = v := by @@ -882,7 +882,7 @@ def compressVec (d : Nat) {k : Nat} (v : RqVec k) : RqVec k := def decompressVec (d : Nat) {k : Nat} (v : RqVec k) : RqVec k := v.map (decompressPoly d) -theorem compress_val_lt_pow {d : Nat} (hpow : (1 <<< d) < modulus) (x : Coeff) : +lemma compress_val_lt_pow {d : Nat} (hpow : (1 <<< d) < modulus) (x : Coeff) : (compress d x : Coeff).val < 2 ^ d := by let shifted := (x.val * (1 <<< d) + modulus / 2) / modulus have hpowPos : 0 < (1 <<< d) := by @@ -897,7 +897,7 @@ theorem compress_val_lt_pow {d : Nat} (hpow : (1 <<< d) < modulus) (x : Coeff) : _ < (1 <<< d) := hmod _ = 2 ^ d := by simp [Nat.shiftLeft_eq] -theorem compressPoly_bound {d : Nat} (hpow : (1 <<< d) < modulus) (f : Rq) : +lemma compressPoly_bound {d : Nat} (hpow : (1 <<< d) < modulus) (f : Rq) : ∀ idx : Fin ringDegree, (((compressPoly d f)[idx.val] : Coeff).val) < 2 ^ d := by intro idx have hcoeff : (compressPoly d f)[idx.val] = compress d (f[idx.val]) := by @@ -906,7 +906,7 @@ theorem compressPoly_bound {d : Nat} (hpow : (1 <<< d) < modulus) (f : Rq) : rw [hcoeff] exact compress_val_lt_pow (d := d) hpow (x := f[idx.val]) -theorem compressVec_bound {d k : Nat} (hpow : (1 <<< d) < modulus) (v : RqVec k) : +lemma compressVec_bound {d k : Nat} (hpow : (1 <<< d) < modulus) (v : RqVec k) : ∀ poly : Fin k, ∀ coeff : Fin ringDegree, (((compressVec d v)[poly.val]'poly.isLt)[coeff.val] : Coeff).val < 2 ^ d := by intro poly coeff @@ -923,7 +923,7 @@ def byteDecode1Msg (msg : Message) : Rq := Vector.ofFn fun idx => ((bits.getD idx.val 0 : Nat) : Coeff) -theorem byteDecode1Msg_val (msg : Message) (idx : Fin ringDegree) : +lemma byteDecode1Msg_val (msg : Message) (idx : Fin ringDegree) : ((byteDecode1Msg msg).get idx : Coeff).val = (bytesToBits (ByteArray.mk msg.toArray)).getD idx.val 0 := by have hbitMod : (bytesToBits (ByteArray.mk msg.toArray)).getD idx.val 0 < modulus := @@ -935,7 +935,7 @@ theorem byteDecode1Msg_val (msg : Message) (idx : Fin ringDegree) : unfold byteDecode1Msg simpa using hcast -theorem messageToArray_ofByteArray (ba : ByteArray) (hsize : ba.size = 32) : +lemma messageToArray_ofByteArray (ba : ByteArray) (hsize : ba.size = 32) : (Vector.ofFn (n := 32) (fun i => ba[i.val]!)).toArray = ba.data := by rw [Vector.toArray_ofFn] apply Array.ext @@ -947,7 +947,7 @@ theorem messageToArray_ofByteArray (ba : ByteArray) (hsize : ba.size = 32) : ba[i]! = ba[i]'hi := getElem!_pos ba i hi _ = ba.data[i]'hi2 := ByteArray.getElem_eq_getElem_data -theorem toArray_byteEncode1Msg (f : Rq) : +lemma toArray_byteEncode1Msg (f : Rq) : (byteEncode1Msg f).toArray = (byteEncode 1 f).data := by let bits : Array Nat := Array.ofFn fun idx : Fin ringDegree => (((f.get idx : Coeff).val) % 2) @@ -982,12 +982,12 @@ theorem toArray_byteEncode1Msg (f : Rq) : unfold byteEncode1Msg simpa [hencode, bits] using messageToArray_ofByteArray (ba := bitsToBytes bits) hsize -theorem byteArray_byteEncode1Msg (f : Rq) : +lemma byteArray_byteEncode1Msg (f : Rq) : ByteArray.mk (byteEncode1Msg f).toArray = byteEncode 1 f := by apply ByteArray.ext simpa using toArray_byteEncode1Msg (f := f) -theorem byteDecode1Msg_eq_byteDecode1 (msg : Message) : +lemma byteDecode1Msg_eq_byteDecode1 (msg : Message) : byteDecode1Msg msg = byteDecode 1 (ByteArray.mk msg.toArray) := LatticeCrypto.Poly.ext_get_eq fun idx => by apply (ZMod.val_injective modulus) @@ -998,7 +998,7 @@ theorem byteDecode1Msg_eq_byteDecode1 (msg : Message) : _ = (((byteDecode 1 (ByteArray.mk msg.toArray)).get idx : Coeff).val) := (byteDecode_one_coeff (ByteArray.mk msg.toArray) idx).symm -theorem byteEncode1Msg_byteDecode1Msg (msg : Message) : +lemma byteEncode1Msg_byteDecode1Msg (msg : Message) : byteEncode1Msg (byteDecode1Msg msg) = msg := by let bits : Array Nat := Array.ofFn fun idx : Fin ringDegree => (((byteDecode1Msg msg).get idx : Coeff).val % 2) @@ -1031,7 +1031,7 @@ theorem byteEncode1Msg_byteDecode1Msg (msg : Message) : _ = (ByteArray.mk msg.toArray).data := by simp [hbytes] _ = msg.toArray := rfl -theorem byteDecode1Msg_byteEncode1Msg_of_bound (f : Rq) +lemma byteDecode1Msg_byteEncode1Msg_of_bound (f : Rq) (hbound : ∀ idx : Fin ringDegree, ((f[idx.val] : Coeff).val) < 2) : byteDecode1Msg (byteEncode1Msg f) = f := by calc @@ -1057,7 +1057,7 @@ def byteArrayToVector (ba : ByteArray) (offset : Nat) (n : Nat) : Vector UInt8 n def ofByteArray {n : Nat} (bytes : ByteArray) (h : bytes.size = n) : Vector UInt8 n := ⟨bytes.data, h⟩ -@[simp] theorem vectorToByteArray_ofByteArray {n : Nat} (bytes : ByteArray) (h : bytes.size = n) : +@[simp] lemma vectorToByteArray_ofByteArray {n : Nat} (bytes : ByteArray) (h : bytes.size = n) : vectorToByteArray (ofByteArray bytes h) = bytes := rfl @@ -1114,7 +1114,7 @@ instance instFintypeConcreteEncodingEncodedV (params : Params) : /-- Coefficients produced by the concrete ML-KEM message decoder `byteDecode1` are bit coefficients, represented by values below `2`. -/ -theorem byteDecode1_get_val_lt_two +lemma byteDecode1_get_val_lt_two (params : Params) (m : Message) (i : Fin ringDegree) : (((concreteEncoding params).byteDecode1 m).get i : Coeff).val < 2 := by change ((byteDecode1Msg m).get i : Coeff).val < 2 @@ -1123,7 +1123,7 @@ theorem byteDecode1_get_val_lt_two /-- Proof bundle showing that the concrete ML-KEM encoding satisfies the abstract encoding laws under the standard bit-width side conditions. -/ -theorem concreteEncodingLaws (params : Params) +lemma concreteEncodingLaws (params : Params) (hduPos : 0 < params.du) (hdvPos : 0 < params.dv) (hduPow : (1 <<< params.du) < modulus) (hdvPow : (1 <<< params.dv) < modulus) : (concreteEncoding params).Laws := by diff --git a/src/Commons/Schemes/KEM/MLKEM/Concrete/Instance.lean b/src/Commons/Schemes/KEM/MLKEM/Concrete/Instance.lean index fbd7eea..9dc920e 100644 --- a/src/Commons/Schemes/KEM/MLKEM/Concrete/Instance.lean +++ b/src/Commons/Schemes/KEM/MLKEM/Concrete/Instance.lean @@ -107,7 +107,7 @@ abbrev mlkem512Encoding : Encoding mlkem512 := concreteEncoding mlkem512 abbrev mlkem1024Encoding : Encoding mlkem1024 := concreteEncoding mlkem1024 /-- Encoding roundtrip laws for ML-KEM-512. -/ -theorem mlkem512EncodingLaws : mlkem512Encoding.Laws := +lemma mlkem512EncodingLaws : mlkem512Encoding.Laws := concreteEncodingLaws mlkem512 (by norm_num [mlkem512, ParameterSet.params, modulus, Nat.shiftLeft_eq]) (by norm_num [mlkem512, ParameterSet.params, modulus, Nat.shiftLeft_eq]) @@ -115,7 +115,7 @@ theorem mlkem512EncodingLaws : mlkem512Encoding.Laws := (by norm_num [mlkem512, ParameterSet.params, modulus, Nat.shiftLeft_eq]) /-- Encoding roundtrip laws for ML-KEM-768. -/ -theorem mlkem768EncodingLaws : mlkem768Encoding.Laws := +lemma mlkem768EncodingLaws : mlkem768Encoding.Laws := concreteEncodingLaws mlkem768 (by norm_num [mlkem768, ParameterSet.params, modulus, Nat.shiftLeft_eq]) (by norm_num [mlkem768, ParameterSet.params, modulus, Nat.shiftLeft_eq]) @@ -123,7 +123,7 @@ theorem mlkem768EncodingLaws : mlkem768Encoding.Laws := (by norm_num [mlkem768, ParameterSet.params, modulus, Nat.shiftLeft_eq]) /-- Encoding roundtrip laws for ML-KEM-1024. -/ -theorem mlkem1024EncodingLaws : mlkem1024Encoding.Laws := +lemma mlkem1024EncodingLaws : mlkem1024Encoding.Laws := concreteEncodingLaws mlkem1024 (by norm_num [mlkem1024, ParameterSet.params, modulus, Nat.shiftLeft_eq]) (by norm_num [mlkem1024, ParameterSet.params, modulus, Nat.shiftLeft_eq]) diff --git a/src/Commons/Schemes/KEM/MLKEM/Concrete/NTT.lean b/src/Commons/Schemes/KEM/MLKEM/Concrete/NTT.lean index ca21e94..85b367d 100644 --- a/src/Commons/Schemes/KEM/MLKEM/Concrete/NTT.lean +++ b/src/Commons/Schemes/KEM/MLKEM/Concrete/NTT.lean @@ -61,35 +61,35 @@ def nInv : Coeff := 3303 /-- Safe array access with fallback to zero. -/ def getZ (a : Array Coeff) (i : Nat) : Coeff := a.getD i 0 -theorem bitRev7_layer_partner : +lemma bitRev7_layer_partner : ∀ (s : Fin 7) (g : Fin (2 ^ s.val)), bitRev7 (2 ^ s.val + g.val) + bitRev7 (2 ^ (s.val + 1) - 1 - g.val) = 128 := by intro s g fin_cases s <;> fin_cases g <;> rfl -theorem layer_twiddle_index_bounds : +lemma layer_twiddle_index_bounds : ∀ (s : Fin 7) (g : Fin (2 ^ s.val)), 2 ^ s.val + g.val < 128 ∧ 2 ^ (s.val + 1) - 1 - g.val < 128 := by intro s g fin_cases s <;> fin_cases g <;> norm_num -theorem getZ_zetaArray (i : Nat) (hi : i < 128) : +lemma getZ_zetaArray (i : Nat) (hi : i < 128) : getZ zetaArray i = zeta ^ bitRev7 i := by simp [getZ, zetaArray, hi] -theorem getZ_gammaArray (i : Nat) (hi : i < 128) : +lemma getZ_gammaArray (i : Nat) (hi : i < 128) : getZ gammaArray i = zeta ^ (2 * bitRev7 i + 1) := by simp [getZ, gammaArray, hi] -theorem zeta_pow_128 : (zeta : Coeff) ^ 128 = -1 := by +lemma zeta_pow_128 : (zeta : Coeff) ^ 128 = -1 := by change (17 : ZMod 3329) ^ 128 = -1 reduce_mod_char /-- `ζ = 17` is a primitive `256`-th root of unity in `ℤ_q` (FIPS 203 §4.3): the twiddle half of the NTT correctness argument. -/ -theorem zeta_isPrimitiveRoot : IsPrimitiveRoot (zeta : Coeff) 256 := by +lemma zeta_isPrimitiveRoot : IsPrimitiveRoot (zeta : Coeff) 256 := by change IsPrimitiveRoot (17 : ZMod 3329) 256 rw [IsPrimitiveRoot.iff_orderOf] refine orderOf_eq_of_pow_and_pow_div_prime (by norm_num) (by reduce_mod_char) ?_ @@ -101,7 +101,7 @@ theorem zeta_isPrimitiveRoot : IsPrimitiveRoot (zeta : Coeff) 256 := by /-- The twiddle used by a forward butterfly and the complementary twiddle used by its matching inverse butterfly multiply to `-1`. -/ -theorem zetaArray_layer_partner : +lemma zetaArray_layer_partner : ∀ (s : Fin 7) (g : Fin (2 ^ s.val)), getZ zetaArray (2 ^ s.val + g.val) * getZ zetaArray (2 ^ (s.val + 1) - 1 - g.val) = -1 := by @@ -112,7 +112,7 @@ theorem zetaArray_layer_partner : /-! ## Forward NTT (Algorithm 9) -/ -theorem layer_shape : +lemma layer_shape : ∀ s : Fin 7, 2 ^ s.val * (2 * (128 / 2 ^ s.val)) = polyBackend.degree := by intro s fin_cases s <;> rfl @@ -149,7 +149,7 @@ def nttStages : List (LatticeCrypto.NTTCert.ScaledStage Coeff NTTCoord) := [nttStage 0, nttStage 1, nttStage 2, nttStage 3, nttStage 4, nttStage 5, nttStage 6] -theorem nInv_stageScalar : +lemma nInv_stageScalar : nInv * LatticeCrypto.NTTCert.stageScalar nttStages = 1 := by change ((3303 * 128 : Nat) : ZMod 3329) = ((1 : Nat) : ZMod 3329) rw [ZMod.natCast_eq_natCast_iff'] @@ -164,23 +164,23 @@ def invNTTCoeffs (input : NTTCoord → Coeff) : NTTCoord → Coeff := LatticeCrypto.NTTCert.scaleCoeffs nInv (LatticeCrypto.NTTCert.inverseStages nttStages input) -theorem invNTTCoeffs_nttCoeffs (input : NTTCoord → Coeff) : +lemma invNTTCoeffs_nttCoeffs (input : NTTCoord → Coeff) : invNTTCoeffs (nttCoeffs input) = input := by unfold invNTTCoeffs nttCoeffs exact LatticeCrypto.NTTCert.scale_inverseStages_forwardStages nttStages nInv nInv_stageScalar input -theorem nttCoeffs_add (left right : NTTCoord → Coeff) : +lemma nttCoeffs_add (left right : NTTCoord → Coeff) : nttCoeffs (left + right) = nttCoeffs left + nttCoeffs right := by unfold nttCoeffs exact LatticeCrypto.NTTCert.forwardStages_add nttStages left right -theorem nttCoeffs_sub (left right : NTTCoord → Coeff) : +lemma nttCoeffs_sub (left right : NTTCoord → Coeff) : nttCoeffs (left - right) = nttCoeffs left - nttCoeffs right := by unfold nttCoeffs exact LatticeCrypto.NTTCert.forwardStages_sub nttStages left right -theorem nttCoeffs_zero : nttCoeffs 0 = 0 := by +lemma nttCoeffs_zero : nttCoeffs 0 = 0 := by unfold nttCoeffs exact LatticeCrypto.NTTCert.forwardStages_zero nttStages @@ -196,11 +196,11 @@ section Evaluation open LatticeCrypto.NTTCert -theorem layerLayout_left_val (s : Fin 7) (g : Fin (2 ^ s.val)) (j : Fin (128 / 2 ^ s.val)) : +lemma layerLayout_left_val (s : Fin 7) (g : Fin (2 ^ s.val)) (j : Fin (128 / 2 ^ s.val)) : ((layerLayout s).equiv ((g, j), false)).val = g.val * (2 * (128 / 2 ^ s.val)) + j.val := by simp [layerLayout] -theorem layerLayout_right_val (s : Fin 7) (g : Fin (2 ^ s.val)) (j : Fin (128 / 2 ^ s.val)) : +lemma layerLayout_right_val (s : Fin 7) (g : Fin (2 ^ s.val)) (j : Fin (128 / 2 ^ s.val)) : ((layerLayout s).equiv ((g, j), true)).val = g.val * (2 * (128 / 2 ^ s.val)) + 128 / 2 ^ s.val + j.val := by simp [layerLayout] @@ -210,7 +210,7 @@ pair `i` evaluates at the roots of `X² − ζ^{2·BitRev₇(i)+1}`. -/ def rootExponent (s g : ℕ) : ℕ := if s < 7 then 2 * bitRev7 (2 ^ s + g) else 2 * bitRev7 g + 1 -theorem rootExponent_children : +lemma rootExponent_children : ∀ (s : Fin 7) (g : Fin (2 ^ s.val)), rootExponent (s.val + 1) (2 * g.val) % 256 = bitRev7 (2 ^ s.val + g.val) % 256 ∧ rootExponent (s.val + 1) (2 * g.val + 1) % 256 = @@ -218,7 +218,7 @@ theorem rootExponent_children : intro s g fin_cases s <;> fin_cases g <;> exact ⟨rfl, rfl⟩ -theorem zeta_pow_mod (a : ℕ) : (zeta : Coeff) ^ a = zeta ^ (a % 256) := by +lemma zeta_pow_mod (a : ℕ) : (zeta : Coeff) ^ a = zeta ^ (a % 256) := by conv_lhs => rw [← Nat.mod_add_div a 256] rw [pow_add, pow_mul, zeta_isPrimitiveRoot.pow_eq_one, one_pow, mul_one] @@ -229,13 +229,13 @@ def EvalInvariant (s : ℕ) (a f : NTTCoord → Coeff) : Prop := ω ^ (256 / 2 ^ s) = algebraMap Coeff S (zeta ^ rootExponent s g) → segmentEval a (g * (256 / 2 ^ s)) (256 / 2 ^ s) ω = segmentEval f 0 256 ω -theorem evalInvariant_zero (f : NTTCoord → Coeff) : EvalInvariant 0 f f := by +lemma evalInvariant_zero (f : NTTCoord → Coeff) : EvalInvariant 0 f f := by intro g hg S _ _ ω _ obtain rfl : g = 0 := by simpa using hg simp /-- **One layer preserves the invariant.** -/ -theorem evalInvariant_step (s : Fin 7) {a f : NTTCoord → Coeff} (h : EvalInvariant s.val a f) : +lemma evalInvariant_step (s : Fin 7) {a f : NTTCoord → Coeff} (h : EvalInvariant s.val a f) : EvalInvariant (s.val + 1) ((nttStage s).forward a) f := by intro g' hg' S _ _ ω hω have hB : 256 / 2 ^ s.val = 2 * (128 / 2 ^ s.val) := by fin_cases s <;> rfl @@ -289,7 +289,7 @@ theorem evalInvariant_step (s : Fin 7) {a f : NTTCoord → Coeff} (h : EvalInvar exact h g hg S ω (hparent (Or.inr hω')) /-- The invariant after all seven layers. -/ -theorem evalInvariant_nttCoeffs (f : NTTCoord → Coeff) : EvalInvariant 7 (nttCoeffs f) f := by +lemma evalInvariant_nttCoeffs (f : NTTCoord → Coeff) : EvalInvariant 7 (nttCoeffs f) f := by have h1 := evalInvariant_step 0 (evalInvariant_zero f) have h2 := evalInvariant_step 1 h1 have h3 := evalInvariant_step 2 h2 @@ -300,7 +300,7 @@ theorem evalInvariant_nttCoeffs (f : NTTCoord → Coeff) : EvalInvariant 7 (nttC /-- **The NTT evaluates**: pair `i` of `nttCoeffs f`, read as `a₀ + a₁ ω`, is `f` at every root `ω` of `X² − ζ^{2·BitRev₇(i)+1}`. -/ -theorem nttCoeffs_pair_eval (f : NTTCoord → Coeff) (i : ℕ) (hi : i < 128) +lemma nttCoeffs_pair_eval (f : NTTCoord → Coeff) (i : ℕ) (hi : i < 128) {S : Type} [CommRing S] [Algebra Coeff S] (ω : S) (hω : ω ^ 2 = algebraMap Coeff S (zeta ^ (2 * bitRev7 i + 1))) : algebraMap Coeff S (coeffAt (nttCoeffs f) (2 * i)) + @@ -310,7 +310,7 @@ theorem nttCoeffs_pair_eval (f : NTTCoord → Coeff) (i : ℕ) (hi : i < 128) rw [← h] simp [segmentEval, Finset.sum_range_succ, mul_comm] -theorem gamma_pow_128 (i : ℕ) : ((zeta : Coeff) ^ (2 * bitRev7 i + 1)) ^ 128 = -1 := by +lemma gamma_pow_128 (i : ℕ) : ((zeta : Coeff) ^ (2 * bitRev7 i + 1)) ^ 128 = -1 := by rw [← pow_mul, mul_comm, pow_mul, zeta_pow_128, (odd_two_mul_add_one _).neg_one_pow] /-- **Base-case multiplication** (FIPS 203 Algorithm 12): the product of `a₀ + a₁X` and @@ -321,7 +321,7 @@ def baseCaseMultiply (a0 a1 b0 b1 γ : Coeff) : Coeff × Coeff := /-- **The NTT turns negacyclic products into base-case products**: pair `i` of the transformed product is the base-case product of pair `i` of the transformed factors modulo `X² − ζ^{2·BitRev₇(i)+1}`. -/ -theorem nttCoeffs_negacyclicConv (f g : NTTCoord → Coeff) (i : ℕ) (hi : i < 128) : +lemma nttCoeffs_negacyclicConv (f g : NTTCoord → Coeff) (i : ℕ) (hi : i < 128) : (coeffAt (nttCoeffs fun k => LatticeCrypto.negacyclicConvCoeff f g k) (2 * i), coeffAt (nttCoeffs fun k => LatticeCrypto.negacyclicConvCoeff f g k) (2 * i + 1)) = baseCaseMultiply (coeffAt (nttCoeffs f) (2 * i)) (coeffAt (nttCoeffs f) (2 * i + 1)) @@ -384,13 +384,13 @@ def invNTT (fHat : Tq) : Rq := (Vector.ofFn (polyBackend.coeff fHat.coeffs))).get) /-- The NTT is the stage composite `nttCoeffs` on coefficient functions. -/ -theorem ntt_eq (f : Rq) : +lemma ntt_eq (f : Rq) : ntt f = ⟨LatticeCrypto.NTTCert.applyCoeffTransform polyBackend nttCoeffs f⟩ := by simp only [ntt, LatticeCrypto.NTTCert.applyCoeffTransform, nttCoeffs, LatticeCrypto.NTTCert.forwardStagesVec_get, LatticeCrypto.NTTCert.get_ofFn] /-- The inverse NTT is the stage composite `invNTTCoeffs` on coefficient functions. -/ -theorem invNTT_eq (fHat : Tq) : +lemma invNTT_eq (fHat : Tq) : invNTT fHat = LatticeCrypto.NTTCert.applyCoeffTransform polyBackend invNTTCoeffs fHat.coeffs := by simp only [invNTT, LatticeCrypto.NTTCert.applyCoeffTransform, invNTTCoeffs, LatticeCrypto.NTTCert.inverseStagesVec_get, LatticeCrypto.NTTCert.get_ofFn] @@ -407,17 +407,17 @@ def multiplyNTTs (fHat gHat : Tq) : Tq := if k.val % 2 = 0 then h.1 else h.2⟩ /-- The concrete inverse transform is a left inverse to the concrete forward transform. -/ -theorem invNTT_ntt (f : Rq) : invNTT (ntt f) = f := by +lemma invNTT_ntt (f : Rq) : invNTT (ntt f) = f := by rw [invNTT_eq, ntt_eq] exact LatticeCrypto.NTTCert.applyCoeffTransform_comp nttCoeffs invNTTCoeffs invNTTCoeffs_nttCoeffs f -theorem ntt_injective : Function.Injective ntt := by +lemma ntt_injective : Function.Injective ntt := by intro f g h have hInv := congrArg invNTT h simpa [invNTT_ntt] using hInv -theorem ntt_surjective : Function.Surjective ntt := by +lemma ntt_surjective : Function.Surjective ntt := by let : NeZero modulus := ⟨by norm_num [modulus]⟩ let : Fintype Coeff := by dsimp [Coeff] @@ -425,19 +425,19 @@ theorem ntt_surjective : Function.Surjective ntt := by let : Finite Rq := Finite.of_equiv (Fin ringDegree → Coeff) rqEquivCoeffFun.symm exact ntt_injective.surjective_of_finite rqEquivTq -theorem hadd_rq (f g : Rq) : +lemma hadd_rq (f g : Rq) : polyBackend.coeff (f + g) = polyBackend.coeff f + polyBackend.coeff g := by funext i change (f + g).get i = f.get i + g.get i exact coeffRing.add_coeff f g i -theorem hsub_rq (f g : Rq) : +lemma hsub_rq (f g : Rq) : polyBackend.coeff (f - g) = polyBackend.coeff f - polyBackend.coeff g := by funext i change (f - g).get i = f.get i - g.get i exact coeffRing.sub_coeff f g i -theorem hzero_rq : polyBackend.coeff (0 : Rq) = 0 := by +lemma hzero_rq : polyBackend.coeff (0 : Rq) = 0 := by funext i change (0 : Rq).get i = 0 exact LatticeCrypto.vectorRing_zero_get i @@ -451,43 +451,43 @@ theorem ntt_invNTT (fHat : Tq) : ntt (invNTT fHat) = fHat := by _ = fHat := hf /-- The concrete NTT is additive on the coefficient-vector carrier of `T_q`. -/ -theorem ntt_add_toRq (f g : Rq) : (ntt (f + g) : Rq) = (ntt f : Rq) + (ntt g : Rq) := by +lemma ntt_add_toRq (f g : Rq) : (ntt (f + g) : Rq) = (ntt f : Rq) + (ntt g : Rq) := by rw [ntt_eq, ntt_eq, ntt_eq] exact LatticeCrypto.NTTCert.applyCoeffTransform_add nttCoeffs hadd_rq nttCoeffs_add f g /-- The concrete NTT preserves subtraction on the coefficient-vector carrier of `T_q`. -/ -theorem ntt_sub_toRq (f g : Rq) : (ntt (f - g) : Rq) = (ntt f : Rq) - (ntt g : Rq) := by +lemma ntt_sub_toRq (f g : Rq) : (ntt (f - g) : Rq) = (ntt f : Rq) - (ntt g : Rq) := by rw [ntt_eq, ntt_eq, ntt_eq] exact LatticeCrypto.NTTCert.applyCoeffTransform_sub nttCoeffs hsub_rq nttCoeffs_sub f g /-- The concrete NTT is additive. -/ -theorem ntt_add (f g : Rq) : ntt (f + g) = ntt f + ntt g := by +lemma ntt_add (f g : Rq) : ntt (f + g) = ntt f + ntt g := by apply LatticeCrypto.TransformPoly.ext change (ntt (f + g) : Rq) = (ntt f : Rq) + (ntt g : Rq) exact ntt_add_toRq f g /-- The concrete NTT preserves subtraction. -/ -theorem ntt_sub (f g : Rq) : ntt (f - g) = ntt f - ntt g := by +lemma ntt_sub (f g : Rq) : ntt (f - g) = ntt f - ntt g := by apply LatticeCrypto.TransformPoly.ext change (ntt (f - g) : Rq) = (ntt f : Rq) - (ntt g : Rq) exact ntt_sub_toRq f g -theorem invNTT_add (g h : Tq) : invNTT (g + h) = invNTT g + invNTT h := by +lemma invNTT_add (g h : Tq) : invNTT (g + h) = invNTT g + invNTT h := by apply ntt_injective rw [ntt_invNTT, ntt_add, ntt_invNTT, ntt_invNTT] -theorem invNTT_sub (g h : Tq) : invNTT (g - h) = invNTT g - invNTT h := by +lemma invNTT_sub (g h : Tq) : invNTT (g - h) = invNTT g - invNTT h := by apply ntt_injective rw [ntt_invNTT, ntt_sub, ntt_invNTT, ntt_invNTT] -theorem hinvadd_tq (fHat gHat : Tq) : +lemma hinvadd_tq (fHat gHat : Tq) : polyBackend.coeff (fHat + gHat).coeffs = fun i => polyBackend.coeff fHat.coeffs i + polyBackend.coeff gHat.coeffs i := by funext i; exact coeffRing.add_coeff fHat.coeffs gHat.coeffs i -theorem negacyclicMul_coeff (a b : Rq) (k : Fin ringDegree) : +lemma negacyclicMul_coeff (a b : Rq) (k : Fin ringDegree) : polyBackend.coeff (negacyclicMul a b) k = LatticeCrypto.negacyclicConvCoeff (polyBackend.coeff a) (polyBackend.coeff b) k := LatticeCrypto.negacyclicMul_coeff polyBackend a b k @@ -518,7 +518,7 @@ theorem ntt_negacyclicMul (f g : Rq) : ntt (negacyclicMul f g) = multiplyNTTs (n rw [h1]; rfl /-- `MultiplyNTTs` is the negacyclic product transported through the NTT. -/ -theorem multiplyNTTs_eq (fHat gHat : Tq) : +lemma multiplyNTTs_eq (fHat gHat : Tq) : multiplyNTTs fHat gHat = ntt (negacyclicMul (invNTT fHat) (invNTT gHat)) := by rw [ntt_negacyclicMul, ntt_invNTT, ntt_invNTT] @@ -530,7 +530,7 @@ theorem multiplyNTTs_eq (fHat gHat : Tq) : /-- Proof bundle showing that the concrete ML-KEM NTT implementation satisfies the abstract `NTTRingLaws`. -/ -theorem concreteNTTRingLaws : NTTRingLaws concreteNTTRingOps where +lemma concreteNTTRingLaws : NTTRingLaws concreteNTTRingOps where fromHat_toHat := invNTT_ntt toHat_fromHat := ntt_invNTT toHat_zero := by diff --git a/src/Commons/Schemes/KEM/MLKEM/Encoding.lean b/src/Commons/Schemes/KEM/MLKEM/Encoding.lean index bc4eb65..db848db 100644 --- a/src/Commons/Schemes/KEM/MLKEM/Encoding.lean +++ b/src/Commons/Schemes/KEM/MLKEM/Encoding.lean @@ -66,7 +66,7 @@ def publicKeyCanonical [DecidableEq encoding.EncodedTHat] (tHatEncoded : encoding.EncodedTHat) : Bool := encoding.byteEncode12Vec (encoding.byteDecode12Vec tHatEncoded) == tHatEncoded -@[simp] theorem publicKeyCanonical_byteEncode12Vec_eq_true +@[simp] lemma publicKeyCanonical_byteEncode12Vec_eq_true [DecidableEq encoding.EncodedTHat] (tHat : TqVec params.k) : encoding.publicKeyCanonical (encoding.byteEncode12Vec tHat) = true := by unfold Encoding.publicKeyCanonical diff --git a/src/Commons/Schemes/KEM/MLKEM/KEM.lean b/src/Commons/Schemes/KEM/MLKEM/KEM.lean index 630323c..43d05fc 100644 --- a/src/Commons/Schemes/KEM/MLKEM/KEM.lean +++ b/src/Commons/Schemes/KEM/MLKEM/KEM.lean @@ -24,14 +24,14 @@ def encapsulationKeyCheck (encoding : Encoding params) [DecidableEq encoding.Enc (ek : EncapsulationKey params encoding) : Bool := encoding.publicKeyCanonical ek.tHatEncoded -@[simp] theorem encapsulationKeyCheck_keygenFromSeed_eq_true (ring : NTTRingOps) +@[simp] lemma encapsulationKeyCheck_keygenFromSeed_eq_true (ring : NTTRingOps) (encoding : Encoding params) [DecidableEq encoding.EncodedTHat] (prims : Primitives params encoding) (d : Seed32) : encapsulationKeyCheck encoding (KPKE.keygenFromSeed ring encoding prims d).1 = true := by unfold encapsulationKeyCheck KPKE.keygenFromSeed simp -@[simp] theorem encapsulationKeyCheck_keygenInternal_eq_true (ring : NTTRingOps) +@[simp] lemma encapsulationKeyCheck_keygenInternal_eq_true (ring : NTTRingOps) (encoding : Encoding params) [DecidableEq encoding.EncodedTHat] (prims : Primitives params encoding) (d z : Seed32) : encapsulationKeyCheck encoding (keygenInternal ring encoding prims d z).1 = true := by diff --git a/src/Commons/Schemes/Lattice/Core.lean b/src/Commons/Schemes/Lattice/Core.lean index 8816471..d83194c 100644 --- a/src/Commons/Schemes/Lattice/Core.lean +++ b/src/Commons/Schemes/Lattice/Core.lean @@ -46,12 +46,12 @@ def toPi (v : PolyVec P k) : Fin k → P := def ofPi (f : Fin k → P) : PolyVec P k := Vector.ofFn f -@[simp] theorem toPi_ofPi (f : Fin k → P) : +@[simp] lemma toPi_ofPi (f : Fin k → P) : toPi (ofPi f) = f := by funext i simp [toPi, ofPi] -@[simp] theorem ofPi_toPi (v : PolyVec P k) : +@[simp] lemma ofPi_toPi (v : PolyVec P k) : ofPi (toPi v) = v := by apply Vector.ext intro i hi @@ -71,12 +71,12 @@ def toMatrix (A : PolyMatrix P rows cols) : Matrix (Fin rows) (Fin cols) P := def ofMatrix (A : Matrix (Fin rows) (Fin cols) P) : PolyMatrix P rows cols := Vector.ofFn fun i => Vector.ofFn fun j => A i j -@[simp] theorem toMatrix_ofMatrix (A : Matrix (Fin rows) (Fin cols) P) : +@[simp] lemma toMatrix_ofMatrix (A : Matrix (Fin rows) (Fin cols) P) : toMatrix (ofMatrix A) = A := by funext i j simp [toMatrix, ofMatrix] -@[simp] theorem ofMatrix_toMatrix (A : PolyMatrix P rows cols) : +@[simp] lemma ofMatrix_toMatrix (A : PolyMatrix P rows cols) : ofMatrix (toMatrix A) = A := by apply Vector.ext intro i hi @@ -110,12 +110,12 @@ variable {Coeff : Type u} def coeffArray (backend : PolyBackend Coeff) (p : backend.Poly) : Array Coeff := Array.ofFn fun i : Fin backend.degree => backend.coeff p i -@[simp] theorem coeff_build_apply (backend : PolyBackend Coeff) +@[simp] lemma coeff_build_apply (backend : PolyBackend Coeff) (f : Fin backend.degree → Coeff) (i : Fin backend.degree) : backend.coeff (backend.build f) i = f i := backend.coeff_build f i -@[simp] theorem build_coeff_apply (backend : PolyBackend Coeff) (p : backend.Poly) : +@[simp] lemma build_coeff_apply (backend : PolyBackend Coeff) (p : backend.Poly) : backend.build (backend.coeff p) = p := backend.build_coeff p @@ -133,7 +133,7 @@ def mapCoeffs {Coeff' : Type v} exact Nat.lt_of_lt_of_eq i.isLt hdeg.symm⟩) /-- Two `backend.Poly` values are equal iff they agree on every coefficient. -/ -@[ext] theorem ext_coeff {backend : PolyBackend Coeff} {p q : backend.Poly} +@[ext] lemma ext_coeff {backend : PolyBackend Coeff} {p q : backend.Poly} (h : ∀ i, backend.coeff p i = backend.coeff q i) : p = q := backend.build_coeff p ▸ backend.build_coeff q ▸ congr_arg backend.build (funext h) @@ -146,12 +146,12 @@ def equivPi (backend : PolyBackend Coeff) : backend.Poly ≃ (Fin backend.degree right_inv f := funext (backend.coeff_build f) /-- `equivPi` reads coefficients through `PolyBackend.coeff`. -/ -@[simp] theorem equivPi_apply (backend : PolyBackend Coeff) (p : backend.Poly) : +@[simp] lemma equivPi_apply (backend : PolyBackend Coeff) (p : backend.Poly) : backend.equivPi p = backend.coeff p := rfl /-- The inverse of `equivPi` rebuilds a carrier through `PolyBackend.build`. -/ -@[simp] theorem equivPi_symm_apply (backend : PolyBackend Coeff) +@[simp] lemma equivPi_symm_apply (backend : PolyBackend Coeff) (f : Fin backend.degree → Coeff) : backend.equivPi.symm f = backend.build f := rfl @@ -197,7 +197,7 @@ noncomputable def ofBackend (backend : PolyBackend R) (p : backend.Poly) : /-- `toPolynomial` is injective: distinct coefficient arrays yield distinct polynomials. -/ -theorem PolyBackend.toPolynomial_injective {R : Type u} [CommRing R] +lemma PolyBackend.toPolynomial_injective {R : Type u} [CommRing R] (backend : PolyBackend R) : Function.Injective backend.toPolynomial := by intro p q h apply PolyBackend.ext_coeff @@ -209,7 +209,7 @@ theorem PolyBackend.toPolynomial_injective {R : Type u} [CommRing R] rw [← extract p, ← extract q, h] /-- Coefficients of `toPolynomial x` at indices `≥ backend.degree` are zero. -/ -theorem PolyBackend.toPolynomial_coeff_high {R : Type u} [CommRing R] +lemma PolyBackend.toPolynomial_coeff_high {R : Type u} [CommRing R] (backend : PolyBackend R) (x : backend.Poly) {j : Nat} (hj : backend.degree ≤ j) : (backend.toPolynomial x).coeff j = 0 := by @@ -221,7 +221,7 @@ theorem PolyBackend.toPolynomial_coeff_high {R : Type u} [CommRing R] /-- `ofBackend` is injective: distinct backend carriers map to distinct elements of the negacyclic quotient. Holds for any `CommRing` coefficient type. -/ -theorem ofBackend_injective +lemma ofBackend_injective {R : Type u} [CommRing R] (backend : PolyBackend R) : Function.Injective (NegacyclicQuotient.ofBackend backend) := by intro p q heq diff --git a/src/Commons/Schemes/Lattice/Kernel.lean b/src/Commons/Schemes/Lattice/Kernel.lean index 7bab3e6..dff2cce 100644 --- a/src/Commons/Schemes/Lattice/Kernel.lean +++ b/src/Commons/Schemes/Lattice/Kernel.lean @@ -139,22 +139,22 @@ instance (ring : NegacyclicRing Coeff) : Mul ring.Poly := ⟨ring.mul⟩ /-- The `i`-th coefficient of `f + g` equals the sum of the individual coefficients. -/ -@[simp] theorem coeff_add (ring : NegacyclicRing Coeff) (f g : ring.Poly) (i : Fin ring.degree) : +@[simp] lemma coeff_add (ring : NegacyclicRing Coeff) (f g : ring.Poly) (i : Fin ring.degree) : ring.backend.coeff (f + g) i = ring.backend.coeff f i + ring.backend.coeff g i := ring.add_coeff f g i /-- The `i`-th coefficient of `f - g` equals the difference of the individual coefficients. -/ -@[simp] theorem coeff_sub (ring : NegacyclicRing Coeff) (f g : ring.Poly) (i : Fin ring.degree) : +@[simp] lemma coeff_sub (ring : NegacyclicRing Coeff) (f g : ring.Poly) (i : Fin ring.degree) : ring.backend.coeff (f - g) i = ring.backend.coeff f i - ring.backend.coeff g i := ring.sub_coeff f g i /-- Every coefficient of the zero polynomial is zero. -/ -@[simp] theorem coeff_zero (ring : NegacyclicRing Coeff) (i : Fin ring.degree) : +@[simp] lemma coeff_zero (ring : NegacyclicRing Coeff) (i : Fin ring.degree) : ring.backend.coeff (0 : ring.Poly) i = 0 := ring.zero_coeff i /-- The `i`-th coefficient of `-f` is the negation of the `i`-th coefficient of `f`. -/ -@[simp] theorem coeff_neg (ring : NegacyclicRing Coeff) (f : ring.Poly) (i : Fin ring.degree) : +@[simp] lemma coeff_neg (ring : NegacyclicRing Coeff) (f : ring.Poly) (i : Fin ring.degree) : ring.backend.coeff (-f) i = -ring.backend.coeff f i := ring.neg_coeff f i @@ -205,7 +205,7 @@ def negacyclicMul {Coeff : Type u} [Ring Coeff] negacyclicConvCoeff (backend.coeff f) (backend.coeff g) k /-- The `i`-th coefficient of `negacyclicMul backend f g` is `negacyclicConvCoeff`. -/ -@[simp] theorem negacyclicMul_coeff {Coeff : Type u} [Ring Coeff] +@[simp] lemma negacyclicMul_coeff {Coeff : Type u} [Ring Coeff] (backend : PolyBackend.{u, u} Coeff) (f g : backend.Poly) (i : Fin backend.degree) : backend.coeff (negacyclicMul backend f g) i = negacyclicConvCoeff (backend.coeff f) (backend.coeff g) i := diff --git a/src/Commons/Schemes/Lattice/NTTCert.lean b/src/Commons/Schemes/Lattice/NTTCert.lean index 4e084ea..add451e 100644 --- a/src/Commons/Schemes/Lattice/NTTCert.lean +++ b/src/Commons/Schemes/Lattice/NTTCert.lean @@ -56,7 +56,7 @@ def applyCoeffTransform (backend : LatticeCrypto.PolyBackend Coeff) backend.build (transform (backend.coeff input)) /-- Lift a coefficient-level roundtrip through a polynomial backend. -/ -theorem applyCoeffTransform_comp +lemma applyCoeffTransform_comp (forward inverse : (Fin backend.degree → Coeff) → (Fin backend.degree → Coeff)) (hroundtrip : ∀ input, inverse (forward input) = input) (input : backend.Poly) : @@ -70,7 +70,7 @@ theorem applyCoeffTransform_comp /-- Lift additivity of a coefficient transformation through a backend whose addition is pointwise on coefficients. -/ -theorem applyCoeffTransform_add +lemma applyCoeffTransform_add (transform : (Fin backend.degree → Coeff) → (Fin backend.degree → Coeff)) [Add Coeff] [Add backend.Poly] @@ -92,7 +92,7 @@ theorem applyCoeffTransform_add simp only [backend.coeff_build, Pi.add_apply] /-- Lift subtraction preservation through a pointwise backend. -/ -theorem applyCoeffTransform_sub +lemma applyCoeffTransform_sub (transform : (Fin backend.degree → Coeff) → (Fin backend.degree → Coeff)) [Sub Coeff] [Sub backend.Poly] @@ -114,7 +114,7 @@ theorem applyCoeffTransform_sub simp only [backend.coeff_build, Pi.sub_apply] /-- Lift zero preservation through a pointwise backend. -/ -theorem applyCoeffTransform_zero +lemma applyCoeffTransform_zero (transform : (Fin backend.degree → Coeff) → (Fin backend.degree → Coeff)) [Zero Coeff] [Zero backend.Poly] @@ -155,7 +155,7 @@ def blockLayout (groups len : Nat) : ((finTwoEquiv.symm.prodCongr (Equiv.refl (Fin len))).trans finProdFinEquiv) |>.trans finProdFinEquiv)) -@[simp] theorem blockLayout_left_val (groups len : Nat) +@[simp] lemma blockLayout_left_val (groups len : Nat) (group : Fin groups) (offset : Fin len) : ((blockLayout groups len).equiv ((group, offset), false)).val = group.val * (2 * len) + offset.val := by @@ -163,7 +163,7 @@ def blockLayout (groups len : Nat) : ac_rfl simpa [blockLayout, finProdFinEquiv, finTwoEquiv] using h -@[simp] theorem blockLayout_right_val (groups len : Nat) +@[simp] lemma blockLayout_right_val (groups len : Nat) (group : Fin groups) (offset : Fin len) : ((blockLayout groups len).equiv ((group, offset), true)).val = group.val * (2 * len) + len + offset.val := by @@ -194,7 +194,7 @@ def inverseButterflyRev (zRev x y : R) : Bool → R | false => x + y | true => zRev * (y - x) -theorem inverseButterflyRev_eq (zRev x y : R) : +lemma inverseButterflyRev_eq (zRev x y : R) : inverseButterflyRev zRev x y = inverseButterfly (-zRev) x y := by funext side cases side <;> simp only [inverseButterflyRev, inverseButterfly] @@ -227,7 +227,7 @@ def inverseStageRev {Pair : Type v} {Coord : Type w} (input (layout.equiv (pairSide.1, false))) (input (layout.equiv (pairSide.1, true))) pairSide.2 -theorem inverseStageRev_eq {Pair : Type v} {Coord : Type w} +lemma inverseStageRev_eq {Pair : Type v} {Coord : Type w} (layout : ButterflyLayout Pair Coord) (zRev : Pair → R) : inverseStageRev layout zRev = inverseStage layout (fun pair => -zRev pair) := by funext input coord @@ -240,7 +240,7 @@ def scaleCoeffs {Coord : Type w} (c : R) (input : Coord → R) : Coord → R := /-- A matching inverse butterfly cancels a forward butterfly up to the factor `2` introduced by the unnormalised sum/difference convention. -/ -theorem inverseButterfly_forwardButterfly +lemma inverseButterfly_forwardButterfly (z zInv u v : R) (hz : zInv * z = 1) : inverseButterfly zInv (forwardButterfly z u v false) (forwardButterfly z u v true) = @@ -258,7 +258,7 @@ theorem inverseButterfly_forwardButterfly /-- Matching inverse and forward stages cancel pointwise up to multiplication by `2`. The only concrete algebraic obligation is the per-pair twiddle inverse law; all schedule coverage and non-overlap follows from `layout.equiv`. -/ -theorem inverseStage_forwardStage +lemma inverseStage_forwardStage {Pair : Type v} {Coord : Type w} (layout : ButterflyLayout Pair Coord) (z zInv : Pair → R) (hz : ∀ pair, zInv pair * z pair = 1) (input : Coord → R) : @@ -286,7 +286,7 @@ theorem inverseStage_forwardStage _ = 2 * input (layout.equiv (pair, true)) := by rw [hz]; ring /-- A stage commutes with pointwise scalar multiplication. -/ -theorem inverseStage_scaleCoeffs +lemma inverseStage_scaleCoeffs {Pair : Type v} {Coord : Type w} (layout : ButterflyLayout Pair Coord) (zInv : Pair → R) (c : R) (input : Coord → R) : inverseStage layout zInv (scaleCoeffs c input) = @@ -299,7 +299,7 @@ theorem inverseStage_scaleCoeffs <;> ring /-- A forward butterfly stage is additive. -/ -theorem forwardStage_add +lemma forwardStage_add {Pair : Type v} {Coord : Type w} (layout : ButterflyLayout Pair Coord) (z : Pair → R) (left right : Coord → R) : forwardStage layout z (left + right) = @@ -312,7 +312,7 @@ theorem forwardStage_add <;> ring /-- A forward butterfly stage preserves subtraction. -/ -theorem forwardStage_sub +lemma forwardStage_sub {Pair : Type v} {Coord : Type w} (layout : ButterflyLayout Pair Coord) (z : Pair → R) (left right : Coord → R) : forwardStage layout z (left - right) = @@ -325,7 +325,7 @@ theorem forwardStage_sub <;> ring /-- A forward butterfly stage preserves zero. -/ -theorem forwardStage_zero +lemma forwardStage_zero {Pair : Type v} {Coord : Type w} (layout : ButterflyLayout Pair Coord) (z : Pair → R) : forwardStage layout z 0 = 0 := by @@ -405,7 +405,7 @@ def stageScalar {Coord : Type w} : List (ScaledStage R Coord) → R /-- A reverse sequence of certified inverse stages cancels its forward stage sequence, accumulating only the product of the per-stage scale factors. -/ -theorem inverseStages_forwardStages {Coord : Type w} +lemma inverseStages_forwardStages {Coord : Type w} (stages : List (ScaledStage R Coord)) (input : Coord → R) : inverseStages stages (forwardStages stages input) = scaleCoeffs (stageScalar stages) input := by @@ -423,7 +423,7 @@ theorem inverseStages_forwardStages {Coord : Type w} /-- Normalize the accumulated stage factor. Concrete NTT developments use this with their final `nInv` constant, leaving only the small closed identity `nInv * stageScalar stages = 1`. -/ -theorem scale_inverseStages_forwardStages {Coord : Type w} +lemma scale_inverseStages_forwardStages {Coord : Type w} (stages : List (ScaledStage R Coord)) (nInv : R) (hnorm : nInv * stageScalar stages = 1) (input : Coord → R) : scaleCoeffs nInv (inverseStages stages (forwardStages stages input)) = input := by @@ -433,7 +433,7 @@ theorem scale_inverseStages_forwardStages {Coord : Type w} rw [← mul_assoc, hnorm, one_mul] /-- A sequence of certified forward stages is additive. -/ -theorem forwardStages_add {Coord : Type w} (stages : List (ScaledStage R Coord)) +lemma forwardStages_add {Coord : Type w} (stages : List (ScaledStage R Coord)) (left right : Coord → R) : forwardStages stages (left + right) = forwardStages stages left + forwardStages stages right := by @@ -444,7 +444,7 @@ theorem forwardStages_add {Coord : Type w} (stages : List (ScaledStage R Coord)) rw [stage.forward_add, ih] /-- A sequence of certified forward stages preserves subtraction. -/ -theorem forwardStages_sub {Coord : Type w} (stages : List (ScaledStage R Coord)) +lemma forwardStages_sub {Coord : Type w} (stages : List (ScaledStage R Coord)) (left right : Coord → R) : forwardStages stages (left - right) = forwardStages stages left - forwardStages stages right := by @@ -455,7 +455,7 @@ theorem forwardStages_sub {Coord : Type w} (stages : List (ScaledStage R Coord)) rw [stage.forward_sub, ih] /-- A sequence of certified forward stages preserves zero. -/ -theorem forwardStages_zero {Coord : Type w} (stages : List (ScaledStage R Coord)) : +lemma forwardStages_zero {Coord : Type w} (stages : List (ScaledStage R Coord)) : forwardStages stages 0 = 0 := by induction stages with | nil => rfl @@ -483,10 +483,10 @@ def inverseStagesVec {n : Nat} : List (ScaledStage R (Fin n)) → Vector R n → omit [CommRing R] in /-- A vector built from a function reads back as the function. -/ -theorem get_ofFn {n : Nat} (f : Fin n → R) : (Vector.ofFn f).get = f := +lemma get_ofFn {n : Nat} (f : Fin n → R) : (Vector.ofFn f).get = f := funext fun i => by simp [Vector.get, Vector.ofFn]; rfl -theorem forwardStagesVec_get {n : Nat} (stages : List (ScaledStage R (Fin n))) (v : Vector R n) : +lemma forwardStagesVec_get {n : Nat} (stages : List (ScaledStage R (Fin n))) (v : Vector R n) : (forwardStagesVec stages v).get = forwardStages stages v.get := by induction stages generalizing v with | nil => rfl @@ -494,7 +494,7 @@ theorem forwardStagesVec_get {n : Nat} (stages : List (ScaledStage R (Fin n))) ( simp only [forwardStagesVec, forwardStages] rw [ih, get_ofFn] -theorem inverseStagesVec_get {n : Nat} (stages : List (ScaledStage R (Fin n))) (v : Vector R n) : +lemma inverseStagesVec_get {n : Nat} (stages : List (ScaledStage R (Fin n))) (v : Vector R n) : (inverseStagesVec stages v).get = inverseStages stages v.get := by induction stages with | nil => rfl @@ -522,7 +522,7 @@ def coeffAt {N : ℕ} (a : Fin N → R) (i : ℕ) : R := if h : i < N then a ⟨ def segmentEval {N : ℕ} (a : Fin N → R) (start L : ℕ) (ω : S) : S := ∑ j ∈ range L, algebraMap R S (coeffAt a (start + j)) * ω ^ j -theorem segmentEval_double {N : ℕ} (a : Fin N → R) (start len : ℕ) (ω : S) : +lemma segmentEval_double {N : ℕ} (a : Fin N → R) (start len : ℕ) (ω : S) : segmentEval a start (2 * len) ω = segmentEval a start len ω + ω ^ len * segmentEval a (start + len) len ω := by unfold segmentEval @@ -535,7 +535,7 @@ theorem segmentEval_double {N : ℕ} (a : Fin N → R) (start len : ℕ) (ω : S /-- **A butterfly preserves evaluations**: if the halves of a segment of length `2 len` become `u + z v` and `u - z v`, the left half evaluates like the segment at every `ω` with `ω ^ len = z`, and the right half at every `ω` with `ω ^ len = -z`. -/ -theorem segmentEval_butterfly {N M : ℕ} (a : Fin N → R) (b : Fin M → R) (start len : ℕ) (z : R) +lemma segmentEval_butterfly {N M : ℕ} (a : Fin N → R) (b : Fin M → R) (start len : ℕ) (z : R) (hleft : ∀ j < len, coeffAt b (start + j) = coeffAt a (start + j) + z * coeffAt a (start + len + j)) (hright : ∀ j < len, coeffAt b (start + len + j) = @@ -562,7 +562,7 @@ theorem segmentEval_butterfly {N M : ℕ} (a : Fin N → R) (b : Fin M → R) (s /-- The left and right outputs of a forward stage on a layout whose pairs sit at `g · 2 len + j` and `g · 2 len + len + j`. -/ -theorem forwardStage_coeffAt {G len N : ℕ} (layout : ButterflyLayout (Fin G × Fin len) (Fin N)) +lemma forwardStage_coeffAt {G len N : ℕ} (layout : ButterflyLayout (Fin G × Fin len) (Fin N)) (hl : ∀ g j, (layout.equiv ((g, j), false)).val = g.val * (2 * len) + j.val) (hr : ∀ g j, (layout.equiv ((g, j), true)).val = g.val * (2 * len) + len + j.val) (z : Fin G × Fin len → R) (a : Fin N → R) (g : Fin G) (j : Fin len) : @@ -583,7 +583,7 @@ theorem forwardStage_coeffAt {G len N : ℕ} (layout : ButterflyLayout (Fin G × · rw [key false _ (hl g j), hA false _ (hl g j), hA true _ (hr g j)]; rfl · rw [key true _ (hr g j), hA false _ (hl g j), hA true _ (hr g j)]; rfl -theorem segmentEval_zero_eq {n : ℕ} (a : Fin n → R) (ω : S) : +lemma segmentEval_zero_eq {n : ℕ} (a : Fin n → R) (ω : S) : segmentEval a 0 n ω = ∑ i : Fin n, algebraMap R S (a i) * ω ^ (i : ℕ) := by unfold segmentEval rw [← Fin.sum_univ_eq_sum_range (fun j => algebraMap R S (coeffAt a (0 + j)) * ω ^ j)] @@ -591,7 +591,7 @@ theorem segmentEval_zero_eq {n : ℕ} (a : Fin n → R) (ω : S) : simp [coeffAt, i.isLt] omit [CommRing R] [Algebra R S] in -theorem sum_ite_val_eq {n : ℕ} (m : ℕ) (hm : m < n) (F : Fin n → S) : +lemma sum_ite_val_eq {n : ℕ} (m : ℕ) (hm : m < n) (F : Fin n → S) : (∑ k : Fin n, if m = k.val then F k else 0) = F ⟨m, hm⟩ := by rw [Finset.sum_eq_single ⟨m, hm⟩] · simp @@ -603,7 +603,7 @@ theorem sum_ite_val_eq {n : ℕ} (m : ℕ) (hm : m < n) (F : Fin n → S) : exact absurd (Finset.mem_univ _) h /-- **Negacyclic products evaluate multiplicatively** at every `ω` with `ω ^ n = -1`. -/ -theorem segmentEval_negacyclicConv {n : ℕ} (f g : Fin n → R) (ω : S) (hω : ω ^ n = -1) : +lemma segmentEval_negacyclicConv {n : ℕ} (f g : Fin n → R) (ω : S) (hω : ω ^ n = -1) : segmentEval (fun k => LatticeCrypto.negacyclicConvCoeff f g k) 0 n ω = segmentEval f 0 n ω * segmentEval g 0 n ω := by rw [segmentEval_zero_eq, segmentEval_zero_eq, segmentEval_zero_eq, sum_mul_sum, @@ -636,7 +636,7 @@ section Quadratic open Polynomial /-- In `R[X] / (X² − γ)`, the root `ω` satisfies `ω² = γ`. -/ -theorem adjoinRoot_root_sq (γ : R) : +lemma adjoinRoot_root_sq (γ : R) : AdjoinRoot.root (X ^ 2 - C γ) ^ 2 = algebraMap R (AdjoinRoot (X ^ 2 - C γ)) γ := by have h := AdjoinRoot.eval₂_root (X ^ 2 - C γ) simp only [eval₂_sub, eval₂_X_pow, eval₂_C] at h @@ -645,7 +645,7 @@ theorem adjoinRoot_root_sq (γ : R) : /-- **Coordinates in `R[X] / (X² − γ)` are unique**: `a + b ω = c + d ω` at the root `ω` only if `a = c` and `b = d`. -/ -theorem adjoinRoot_pair_injective [Nontrivial R] {γ a b c d : R} +lemma adjoinRoot_pair_injective [Nontrivial R] {γ a b c d : R} (h : algebraMap R (AdjoinRoot (X ^ 2 - C γ)) a + algebraMap R _ b * AdjoinRoot.root (X ^ 2 - C γ) = algebraMap R _ c + algebraMap R _ d * AdjoinRoot.root (X ^ 2 - C γ)) : diff --git a/src/Commons/Schemes/Lattice/Norms.lean b/src/Commons/Schemes/Lattice/Norms.lean index c703b1f..6fd48a4 100644 --- a/src/Commons/Schemes/Lattice/Norms.lean +++ b/src/Commons/Schemes/Lattice/Norms.lean @@ -54,52 +54,52 @@ returns the integer itself, following `ZMod.valMinAbs`. -/ def centeredRepr (x : ZMod q) : ℤ := x.valMinAbs /-- The centered representative is `ZMod.valMinAbs` by definition. -/ -theorem centeredRepr_eq_valMinAbs (x : ZMod q) : +lemma centeredRepr_eq_valMinAbs (x : ZMod q) : centeredRepr x = x.valMinAbs := rfl /-- Negation preserves the absolute value of the centered representative. -/ -theorem centeredRepr_natAbs_neg (x : ZMod q) : +lemma centeredRepr_natAbs_neg (x : ZMod q) : (centeredRepr (-x)).natAbs = (centeredRepr x).natAbs := ZMod.natAbs_valMinAbs_neg x /-- Casting the centered representative back into `ZMod q` recovers the original element. -/ -theorem centeredRepr_intCast (x : ZMod q) : +lemma centeredRepr_intCast (x : ZMod q) : (x : ZMod q) = ((centeredRepr x : ℤ) : ZMod q) := (ZMod.coe_valMinAbs x).symm variable [NeZero q] -theorem centeredRepr_of_le {x : ZMod q} (h : (x.val : ℤ) ≤ (q : ℤ) / 2) : +lemma centeredRepr_of_le {x : ZMod q} (h : (x.val : ℤ) ≤ (q : ℤ) / 2) : centeredRepr x = x.val := by rw [centeredRepr, ZMod.valMinAbs_def_pos, if_pos (by omega)] -theorem centeredRepr_of_gt {x : ZMod q} (h : (q : ℤ) / 2 < (x.val : ℤ)) : +lemma centeredRepr_of_gt {x : ZMod q} (h : (q : ℤ) / 2 < (x.val : ℤ)) : centeredRepr x = (x.val : ℤ) - q := by rw [centeredRepr, ZMod.valMinAbs_def_pos, if_neg (by omega)] /-- The centered representative is always at most `q / 2`. -/ -theorem centeredRepr_upper_bound (x : ZMod q) : centeredRepr x ≤ (q : ℤ) / 2 := by +lemma centeredRepr_upper_bound (x : ZMod q) : centeredRepr x ≤ (q : ℤ) / 2 := by have := (ZMod.valMinAbs_mem_Ioc x).2 unfold centeredRepr omega /-- The centered representative has absolute value at most `q / 2`. -/ -theorem centeredRepr_abs_le (x : ZMod q) : (centeredRepr x).natAbs ≤ q / 2 := +lemma centeredRepr_abs_le (x : ZMod q) : (centeredRepr x).natAbs ≤ q / 2 := ZMod.natAbs_valMinAbs_le x /-- Twice the centered representative lies in the interval used by `ZMod.valMinAbs`. -/ -theorem centeredRepr_mem_Ioc (x : ZMod q) : +lemma centeredRepr_mem_Ioc (x : ZMod q) : centeredRepr x * 2 ∈ Set.Ioc (-(q : ℤ)) q := ZMod.valMinAbs_mem_Ioc x /-- Casting an integer already in the centered interval preserves that integer. -/ -theorem centeredRepr_intCast_eq (z : ℤ) +lemma centeredRepr_intCast_eq (z : ℤ) (hzlo : -(q : ℤ) < z * 2) (hzhi : z * 2 ≤ q) : centeredRepr ((z : ZMod q)) = z := (ZMod.valMinAbs_spec ((z : ZMod q)) z).2 ⟨rfl, ⟨hzlo, hzhi⟩⟩ /-- A small-enough integer is unchanged by casting into `ZMod q` and taking `centeredRepr`. -/ -theorem centeredRepr_intCast_eq_of_natAbs_le (z : ℤ) {b : ℕ} +lemma centeredRepr_intCast_eq_of_natAbs_le (z : ℤ) {b : ℕ} (hbound : z.natAbs ≤ b) (hbq : 2 * b < q) : centeredRepr ((z : ZMod q)) = z := by apply centeredRepr_intCast_eq @@ -109,13 +109,13 @@ theorem centeredRepr_intCast_eq_of_natAbs_le (z : ℤ) {b : ℕ} omega /-- A `natAbs` bound yields both lower and upper integer bounds. -/ -theorem neg_le_and_le_of_natAbs_le {z : ℤ} {b : ℕ} +lemma neg_le_and_le_of_natAbs_le {z : ℤ} {b : ℕ} (hbound : z.natAbs ≤ b) : -(b : ℤ) ≤ z ∧ z ≤ b := by constructor <;> omega /-- Lower and upper integer bounds yield a `natAbs` bound. Inverse of `neg_le_and_le_of_natAbs_le`. -/ -theorem natAbs_le_of_neg_le_and_le {z : ℤ} {b : ℕ} +lemma natAbs_le_of_neg_le_and_le {z : ℤ} {b : ℕ} (hl : -(b : ℤ) ≤ z) (hu : z ≤ b) : z.natAbs ≤ b := by omega @@ -162,7 +162,7 @@ def intConvCoeff (f g : Fin n → ZMod q) (k : Fin n) : ℤ := /-- `negacyclicConvCoeff` is the `ZMod q` reduction of the integer convolution `intConvCoeff` of the centered lifts. -/ -theorem negacyclicConvCoeff_eq_intCast (f g : Fin n → ZMod q) (k : Fin n) : +lemma negacyclicConvCoeff_eq_intCast (f g : Fin n → ZMod q) (k : Fin n) : negacyclicConvCoeff f g k = ((intConvCoeff f g k : ℤ) : ZMod q) := by rw [intConvCoeff, negacyclicConvCoeff, Int.cast_sum] apply Finset.sum_congr rfl @@ -178,7 +178,7 @@ theorem negacyclicConvCoeff_eq_intCast (f g : Fin n → ZMod q) (k : Fin n) : /-- The integer negacyclic convolution at any output index is bounded in absolute value by `(∑ |centeredRepr (f i)|) * bg`, where `bg` bounds every `|centeredRepr (g j)|`. The negacyclic wrap index `(i + j) % n = k` matches at most one `j` per `i`, removing the spurious factor `n`. -/ -theorem intConvCoeff_natAbs_le (f g : Fin n → ZMod q) (k : Fin n) (bg : ℕ) +lemma intConvCoeff_natAbs_le (f g : Fin n → ZMod q) (k : Fin n) (bg : ℕ) (hg : ∀ j, (centeredRepr (g j)).natAbs ≤ bg) : (intConvCoeff f g k).natAbs ≤ (∑ i : Fin n, (centeredRepr (f i)).natAbs) * bg := by refine (Int.natAbs_sum_le _ _).trans ?_ @@ -215,7 +215,7 @@ theorem intConvCoeff_natAbs_le (f g : Fin n → ZMod q) (k : Fin n) (bg : ℕ) /-- The `k`-th coefficient of the negacyclic product equals the negacyclic convolution of the component coefficient functions. -/ -theorem mul_get_eq_convCoeff (f g : (vectorNegacyclicRing (ZMod q) n).Poly) (i : Fin n) : +lemma mul_get_eq_convCoeff (f g : (vectorNegacyclicRing (ZMod q) n).Poly) (i : Fin n) : (f * g).get i = negacyclicConvCoeff f.get g.get i := by rw [vectorRing_mul_apply] exact vectorKernel_mul_get f g i @@ -230,24 +230,24 @@ def cInfNorm (p : Poly (ZMod q) n) : ℕ := def l1Norm (p : Poly (ZMod q) n) : ℕ := l1NormOf (vectorBackend (ZMod q) n) (zmodCenteredCoeffView q) p -theorem cInfNorm_le_iff {p : Poly (ZMod q) n} {b : ℕ} : +lemma cInfNorm_le_iff {p : Poly (ZMod q) n} {b : ℕ} : cInfNorm p ≤ b ↔ ∀ i : Fin n, (centeredRepr (p.get i)).natAbs ≤ b := by simp [cInfNorm, cInfNormOf, vectorBackend, zmodCenteredCoeffView, Finset.sup_le_iff] -theorem cInfNorm_le_of_coeff_le {p : Poly (ZMod q) n} {b : ℕ} +lemma cInfNorm_le_of_coeff_le {p : Poly (ZMod q) n} {b : ℕ} (h : ∀ i : Fin n, (centeredRepr (p.get i)).natAbs ≤ b) : cInfNorm p ≤ b := cInfNorm_le_iff.mpr h -theorem coeff_le_cInfNorm (p : Poly (ZMod q) n) (i : Fin n) : +lemma coeff_le_cInfNorm (p : Poly (ZMod q) n) (i : Fin n) : (centeredRepr (p.get i)).natAbs ≤ cInfNorm p := Finset.le_sup (f := fun i => (centeredRepr (p.get i)).natAbs) (Finset.mem_univ i) /-- Every polynomial has centered infinity norm at most `q / 2`. -/ -theorem cInfNorm_le_halfq (p : Poly (ZMod q) n) : cInfNorm p ≤ q / 2 := +lemma cInfNorm_le_halfq (p : Poly (ZMod q) n) : cInfNorm p ≤ q / 2 := cInfNorm_le_iff.mpr (fun i => centeredRepr_abs_le (p.get i)) /-- Negation preserves the centered infinity norm. -/ -@[simp] theorem cInfNorm_neg (f : Poly (ZMod q) n) : cInfNorm (-f) = cInfNorm f := by +@[simp] lemma cInfNorm_neg (f : Poly (ZMod q) n) : cInfNorm (-f) = cInfNorm f := by simp only [cInfNorm, cInfNormOf, vectorBackend, zmodCenteredCoeffView] congr 1 ext i @@ -255,12 +255,12 @@ theorem cInfNorm_le_halfq (p : Poly (ZMod q) n) : cInfNorm p ≤ q / 2 := rw [hneg, centeredRepr_natAbs_neg] /-- The `ℓ₁` norm expands as the sum of the centered absolute values of the coefficients. -/ -theorem l1Norm_eq_sum (p : Poly (ZMod q) n) : +lemma l1Norm_eq_sum (p : Poly (ZMod q) n) : l1Norm p = ∑ i : Fin n, (centeredRepr (p.get i)).natAbs := by unfold l1Norm l1NormOf rfl -theorem l1Norm_le_of_cInfNorm_le {p : Poly (ZMod q) n} {b : ℕ} +lemma l1Norm_le_of_cInfNorm_le {p : Poly (ZMod q) n} {b : ℕ} (h : cInfNorm p ≤ b) : l1Norm p ≤ n * b := by unfold l1Norm l1NormOf calc @@ -281,7 +281,7 @@ ML-DSA `‖c · s‖∞ ≤ τ · η` challenge-product bound. -/ `ℤ_q[X] / (X^n + 1)`, the centered `ℓ∞` norm of the product is bounded by the `ℓ₁` norm of the first factor times the `ℓ∞` norm of the second. Unconditional: the no-wraparound argument applies when `l1Norm f * cInfNorm g < q / 2`, and otherwise `cInfNorm_le_halfq` already gives the bound. -/ -theorem cInfNorm_mul_le (f g : (vectorNegacyclicRing (ZMod q) n).Poly) : +lemma cInfNorm_mul_le (f g : (vectorNegacyclicRing (ZMod q) n).Poly) : cInfNorm (f * g) ≤ l1Norm f * cInfNorm g := by set bound := l1Norm f * cInfNorm g with hbound rw [cInfNorm_le_iff] @@ -310,12 +310,12 @@ def cInfNorm (v : PolyVec backend.Poly k) : ℕ := /-- A polynomial vector has centered infinity norm at most `b` exactly when each component polynomial does. -/ -theorem cInfNorm_le_iff {v : PolyVec backend.Poly k} {b : ℕ} : +lemma cInfNorm_le_iff {v : PolyVec backend.Poly k} {b : ℕ} : PolyVec.cInfNorm ops v ≤ b ↔ ∀ j : Fin k, ops.cInfNorm (v.get j) ≤ b := by simp [PolyVec.cInfNorm, Finset.sup_le_iff] /-- Each component polynomial is bounded by the centered infinity norm of the whole vector. -/ -theorem component_cInfNorm_le (v : PolyVec backend.Poly k) (j : Fin k) : +lemma component_cInfNorm_le (v : PolyVec backend.Poly k) (j : Fin k) : ops.cInfNorm (v.get j) ≤ PolyVec.cInfNorm ops v := Finset.le_sup (f := fun j => ops.cInfNorm (v.get j)) (Finset.mem_univ j) @@ -333,7 +333,7 @@ def zmodPolyNormOps (q : ℕ) [NeZero q] (backend : PolyBackend (ZMod q)) : Norm infinity norm. Keeping this bridge at the generic layer prevents clients from unfolding an entire concrete ring bundle merely to expose the shared coefficient formula. -/ @[simp] -theorem zmodPolyNormOps_cInfNorm {q n : ℕ} [NeZero q] (p : Poly (ZMod q) n) : +lemma zmodPolyNormOps_cInfNorm {q n : ℕ} [NeZero q] (p : Poly (ZMod q) n) : (zmodPolyNormOps q (vectorBackend (ZMod q) n)).cInfNorm p = cInfNorm p := rfl diff --git a/src/Commons/Schemes/Lattice/SchoolbookCert.lean b/src/Commons/Schemes/Lattice/SchoolbookCert.lean index 14952c7..9568fa7 100644 --- a/src/Commons/Schemes/Lattice/SchoolbookCert.lean +++ b/src/Commons/Schemes/Lattice/SchoolbookCert.lean @@ -33,24 +33,24 @@ noncomputable abbrev mkQ (R : Type*) [CommRing R] (n : Nat) : /-! ## Section 1: Negacyclic Quotient Algebra -/ /-- The negacyclic modulus `X^n + 1` maps to zero in the quotient. -/ -theorem mk_negacyclicModulus_eq_zero : +lemma mk_negacyclicModulus_eq_zero : mkQ R n (negacyclicModulus R n) = 0 := Ideal.Quotient.eq_zero_iff_mem.mpr (Ideal.subset_span rfl) /-- In `R[X]/(X^n + 1)`, `X^n = -1`. -/ -theorem mk_X_pow_n : mkQ R n ((X : Polynomial R) ^ n) = -1 := by +lemma mk_X_pow_n : mkQ R n ((X : Polynomial R) ^ n) = -1 := by have h := mk_negacyclicModulus_eq_zero (R := R) (n := n) have h' : mkQ R n ((X : Polynomial R) ^ n) + 1 = 0 := by simpa [negacyclicModulus, map_add, map_one] using h exact (add_eq_zero_iff_eq_neg.mp h') /-- In `R[X]/(X^n + 1)`, `X^(k + n) = -X^k`. -/ -theorem mk_X_pow_add_n (k : Nat) : +lemma mk_X_pow_add_n (k : Nat) : mkQ R n ((X : Polynomial R) ^ (k + n)) = -(mkQ R n (X ^ k)) := by rw [pow_add, map_mul, mk_X_pow_n]; ring /-- In `R[X]/(X^n + 1)`, `monomial (k + n) c = -monomial k c`. -/ -theorem mk_monomial_add_n (k : Nat) (c : R) : +lemma mk_monomial_add_n (k : Nat) (c : R) : mkQ R n (Polynomial.monomial (k + n) c) = -(mkQ R n (Polynomial.monomial k c)) := by rw [← C_mul_X_pow_eq_monomial, ← C_mul_X_pow_eq_monomial, map_mul, map_mul, @@ -60,7 +60,7 @@ theorem mk_monomial_add_n (k : Nat) (c : R) : /-! ## Section 2: Product Expansion -/ /-- The product of two `toPolynomial` sums equals a double sum of monomial products. -/ -theorem toPolynomial_mul_eq_double_sum (backend : PolyBackend R) (f g : backend.Poly) : +lemma toPolynomial_mul_eq_double_sum (backend : PolyBackend R) (f g : backend.Poly) : backend.toPolynomial f * backend.toPolynomial g = ∑ i : Fin backend.degree, ∑ j : Fin backend.degree, Polynomial.monomial (i.val + j.val) (backend.coeff f i * backend.coeff g j) := by @@ -70,7 +70,7 @@ theorem toPolynomial_mul_eq_double_sum (backend : PolyBackend R) (f g : backend. /-- The key algebraic step: the double sum of monomial products maps to the same quotient element as the negacyclic convolution polynomial. -/ -theorem mk_double_sum_eq_mk_negacyclicConv (hn : 0 < n) (f g : Fin n → R) : +lemma mk_double_sum_eq_mk_negacyclicConv (hn : 0 < n) (f g : Fin n → R) : mkQ R n (∑ i : Fin n, ∑ j : Fin n, Polynomial.monomial (i.val + j.val) (f i * g j)) = mkQ R n (∑ k : Fin n, Polynomial.monomial k.val (negacyclicConvCoeff f g k)) := by @@ -167,7 +167,7 @@ theorem mk_double_sum_eq_mk_negacyclicConv (hn : 0 < n) (f g : Fin n → R) : /-- `toPolynomial` of the negacyclic multiplication equals the negacyclic convolution polynomial. -/ -theorem negacyclicMul_toPolynomial (backend : PolyBackend R) (f g : backend.Poly) : +lemma negacyclicMul_toPolynomial (backend : PolyBackend R) (f g : backend.Poly) : backend.toPolynomial (negacyclicMul backend f g) = ∑ k : Fin backend.degree, Polynomial.monomial k.val @@ -176,7 +176,7 @@ theorem negacyclicMul_toPolynomial (backend : PolyBackend R) (f g : backend.Poly /-- Soundness of `negacyclicMul`: its image in `R[X]/(X^n + 1)` equals the product of the images. -/ -theorem negacyclicMul_sound (backend : PolyBackend R) (f g : backend.Poly) : +lemma negacyclicMul_sound (backend : PolyBackend R) (f g : backend.Poly) : NegacyclicQuotient.ofBackend backend (negacyclicMul backend f g) = NegacyclicQuotient.ofBackend backend f * NegacyclicQuotient.ofBackend backend g := by @@ -195,7 +195,7 @@ theorem negacyclicMul_sound (backend : PolyBackend R) (f g : backend.Poly) : /-- The constant-`1` vector maps to `1` in `R[X] / (X^n + 1)` for `n > 0`. For `n = 0`, `X^0 + 1 = 2` and `mk(0) = 1` fails for general `CommRing` (e.g. `ℤ[X] / (2)`), so this theorem requires positivity. -/ -theorem vectorNegacyclicSemantics_one_sound +lemma vectorNegacyclicSemantics_one_sound (Coeff : Type*) [CommRing Coeff] {n : Nat} (hn : 0 < n) : NegacyclicQuotient.ofBackend (vectorBackend Coeff n) (vectorNegacyclicRing Coeff n).one = 1 := by diff --git a/src/Commons/Schemes/Lattice/Transform.lean b/src/Commons/Schemes/Lattice/Transform.lean index f26d959..6afbce7 100644 --- a/src/Commons/Schemes/Lattice/Transform.lean +++ b/src/Commons/Schemes/Lattice/Transform.lean @@ -78,12 +78,12 @@ def equivPoly (ring : NegacyclicRing Coeff) : TransformPoly ring ≃ ring.Poly w right_inv _ := rfl /-- `equivPoly` forgets the transform-domain tag. -/ -@[simp] theorem equivPoly_apply (fHat : TransformPoly ring) : +@[simp] lemma equivPoly_apply (fHat : TransformPoly ring) : equivPoly ring fHat = fHat.coeffs := rfl /-- The inverse of `equivPoly` attaches the transform-domain tag. -/ -@[simp] theorem equivPoly_symm_apply (f : ring.Poly) : +@[simp] lemma equivPoly_symm_apply (f : ring.Poly) : (equivPoly ring).symm f = ⟨f⟩ := rfl @@ -116,7 +116,7 @@ instance : AddCommGroup (TransformPoly ring) where nsmul := nsmulRec zsmul := zsmulRec -@[simp] theorem getElem_eq_coeffs_getElem +@[simp] lemma getElem_eq_coeffs_getElem (fHat : TransformPoly ring) {i : Nat} (hi : i < ring.degree) : fHat[i] = ring.backend.coeff fHat.coeffs ⟨i, hi⟩ := rfl @@ -208,11 +208,11 @@ def coeffMatTransposeVecMul {rows cols : Nat} PolyVec ring.Poly cols := ops.unhatVec (ops.matTransposeVecMul A (ops.hatVec v)) -@[simp] theorem hatVec_get {k : Nat} (v : PolyVec ring.Poly k) (i : Fin k) : +@[simp] lemma hatVec_get {k : Nat} (v : PolyVec ring.Poly k) (i : Fin k) : (ops.hatVec v).get i = ops.toHat (v.get i) := Vector.get_map v ops.toHat i -@[simp] theorem unhatVec_get {k : Nat} (v : PolyVec Hat k) (i : Fin k) : +@[simp] lemma unhatVec_get {k : Nat} (v : PolyVec Hat k) (i : Fin k) : (ops.unhatVec v).get i = ops.fromHat (v.get i) := Vector.get_map v ops.fromHat i @@ -253,52 +253,52 @@ class Laws (ops : TransformOps ring Hat) : Prop where variable [laws : Laws ops] -theorem hatVec_add {k} (u v : PolyVec ring.Poly k) : +lemma hatVec_add {k} (u v : PolyVec ring.Poly k) : ops.hatVec (u + v) = ops.hatVec u + ops.hatVec v := by refine Vector.ext fun i _ => ?_ simp only [hatVec, Vector.getElem_map, Vector.getElem_add] exact laws.toHat_add u[i] v[i] -theorem hatVec_sub {k} (u v : PolyVec ring.Poly k) : +lemma hatVec_sub {k} (u v : PolyVec ring.Poly k) : ops.hatVec (u - v) = ops.hatVec u - ops.hatVec v := by refine Vector.ext fun i _ => ?_ simp only [hatVec, Vector.getElem_map, Vector.getElem_sub] exact laws.toHat_sub u[i] v[i] -theorem addHat_eq (a b : Hat) : +lemma addHat_eq (a b : Hat) : a + b = ops.toHat (ops.fromHat a + ops.fromHat b) := by rw [← laws.toHat_fromHat a, ← laws.toHat_fromHat b, ← laws.toHat_add] congr 3 · rw[laws.toHat_fromHat] · rw[laws.toHat_fromHat] -theorem unhatVec_add {k} (uHat vHat : PolyVec Hat k) : +lemma unhatVec_add {k} (uHat vHat : PolyVec Hat k) : ops.unhatVec (uHat + vHat) = ops.unhatVec uHat + ops.unhatVec vHat := by refine Vector.ext fun i _ => ?_ simp only [unhatVec, Vector.getElem_map, Vector.getElem_add] rw [addHat_eq ops, laws.fromHat_toHat] -theorem subHat_eq (a b : Hat) : +lemma subHat_eq (a b : Hat) : a - b = ops.toHat (ops.fromHat a - ops.fromHat b) := by rw [← laws.toHat_fromHat a, ← laws.toHat_fromHat b, ← laws.toHat_sub] congr 3 · rw[laws.toHat_fromHat] · rw[laws.toHat_fromHat] -theorem unhatVec_sub {k} (uHat vHat : PolyVec Hat k) : +lemma unhatVec_sub {k} (uHat vHat : PolyVec Hat k) : ops.unhatVec (uHat - vHat) = ops.unhatVec uHat - ops.unhatVec vHat := by refine Vector.ext fun i _ => ?_ simp only [unhatVec, Vector.getElem_map, Vector.getElem_sub] rw [subHat_eq ops, laws.fromHat_toHat] -theorem zipWith_push {β γ} {n : ℕ} +lemma zipWith_push {β γ} {n : ℕ} (f : α → β → γ) (a : Vector α n) (b : Vector β n) (x : α) (y : β) : Vector.zipWith f (a.push x) (b.push y) = (Vector.zipWith f a b).push (f x y) := by refine Vector.ext fun i _ => ?_ simp only [Vector.getElem_zipWith, Vector.getElem_push] by_cases h : i < n <;> simp [h] -theorem foldl_distribute {k} (a b : PolyVec Hat k) : +lemma foldl_distribute {k} (a b : PolyVec Hat k) : (a + b).foldl (· + ·) 0 = (a.foldl (· + ·) 0) + (b.foldl (· + ·) 0) := by induction k with | zero => @@ -317,7 +317,7 @@ theorem foldl_distribute {k} (a b : PolyVec Hat k) : rw [zipWith_push, Vector.foldl_push, Vector.foldl_push, Vector.foldl_push, this] abel -theorem dot_add_right {k} (row u v : PolyVec Hat k) : +lemma dot_add_right {k} (row u v : PolyVec Hat k) : ops.dot row (u + v) = (ops.dot row u) + ops.dot row v := by have h_pt : Vector.zipWith ops.mulHat row (u + v) = (row.zipWith ops.mulHat u) + (row.zipWith ops.mulHat v) := by @@ -326,34 +326,34 @@ theorem dot_add_right {k} (row u v : PolyVec Hat k) : simp only [dot] rw [h_pt, foldl_distribute] -theorem matVecMul_add {r c} (A : PolyMatrix Hat r c) (u v : PolyVec Hat c) : +lemma matVecMul_add {r c} (A : PolyMatrix Hat r c) (u v : PolyVec Hat c) : ops.matVecMul A (u + v) = (ops.matVecMul A u) + ops.matVecMul A v := by simp only [matVecMul] refine Vector.ext fun i _ => ?_ simp only [Vector.getElem_map, Vector.getElem_add] exact dot_add_right ops _ u v -theorem mulHat_comm (a b : Hat) : +lemma mulHat_comm (a b : Hat) : ops.mulHat a b = ops.mulHat b a := by rw [show a = ops.toHat (ops.fromHat a) from (laws.toHat_fromHat a).symm, show b = ops.toHat (ops.fromHat b) from (laws.toHat_fromHat b).symm, ← laws.toHat_mul, laws.mul_comm, laws.toHat_mul] -theorem mulHat_assoc (a b c : Hat) : +lemma mulHat_assoc (a b c : Hat) : ops.mulHat (ops.mulHat a b) c = ops.mulHat a (ops.mulHat b c) := laws.mul_assoc a b c -theorem fromHat_subHat (a b : Hat) : +lemma fromHat_subHat (a b : Hat) : ops.fromHat (a - b) = ops.fromHat a - ops.fromHat b := by conv_lhs => rw [← laws.toHat_fromHat a, ← laws.toHat_fromHat b, ← laws.toHat_sub] exact laws.fromHat_toHat _ -theorem fromHat_addHat (a b : Hat) : +lemma fromHat_addHat (a b : Hat) : ops.fromHat (a + b) = ops.fromHat a + ops.fromHat b := by conv_lhs => rw [← laws.toHat_fromHat a, ← laws.toHat_fromHat b, ← laws.toHat_add] exact laws.fromHat_toHat _ -theorem coeffScalarVecMul_sub {k} (c : ring.Poly) +lemma coeffScalarVecMul_sub {k} (c : ring.Poly) (u v : PolyVec ring.Poly k) : ops.coeffScalarVecMul c (u - v) = ops.coeffScalarVecMul c u - ops.coeffScalarVecMul c v := by @@ -362,7 +362,7 @@ theorem coeffScalarVecMul_sub {k} (c : ring.Poly) Vector.getElem_map, Vector.getElem_sub] rw[laws.toHat_sub u[i] v[i], laws.mul_sub, fromHat_subHat ops] -theorem coeffScalarVecMul_add {k} (c : ring.Poly) +lemma coeffScalarVecMul_add {k} (c : ring.Poly) (u v : PolyVec ring.Poly k) : ops.coeffScalarVecMul c (u + v) = ops.coeffScalarVecMul c u + ops.coeffScalarVecMul c v := by @@ -374,12 +374,12 @@ theorem coeffScalarVecMul_add {k} (c : ring.Poly) /-- Coefficient-domain scalar-vector multiplication acts component-wise as the underlying ring multiplication: the `j`-th entry of `coeffScalarVecMul c v` is `c * v.get j`. Follows from the transform being a ring isomorphism (`toHat_mul` and `fromHat_toHat`). -/ -theorem coeffScalarVecMul_get {k} (c : ring.Poly) (v : PolyVec ring.Poly k) (j : Fin k) : +lemma coeffScalarVecMul_get {k} (c : ring.Poly) (v : PolyVec ring.Poly k) (j : Fin k) : (ops.coeffScalarVecMul c v).get j = c * (v.get j) := by simp only [coeffScalarVecMul, unhatVec_get, scalarVecMul, hatVec_get, Vector.get_map] rw [← laws.toHat_mul, laws.fromHat_toHat] -theorem dot_scalar_right {k} (cHat : Hat) +lemma dot_scalar_right {k} (cHat : Hat) (row v : PolyVec Hat k) : ops.dot row (ops.scalarVecMul cHat v) = ops.mulHat cHat (ops.dot row v) := by induction k with diff --git a/src/Commons/Schemes/Lattice/VectorBackend.lean b/src/Commons/Schemes/Lattice/VectorBackend.lean index 93f9322..fed03d6 100644 --- a/src/Commons/Schemes/Lattice/VectorBackend.lean +++ b/src/Commons/Schemes/Lattice/VectorBackend.lean @@ -48,7 +48,7 @@ def toPi (p : Poly Coeff n) : Fin n → Coeff := def ofPi (f : Fin n → Coeff) : Poly Coeff n := Vector.ofFn f -@[simp] theorem get_ofPi (f : Fin n → Coeff) (i : Fin n) : +@[simp] lemma get_ofPi (f : Fin n → Coeff) (i : Fin n) : (ofPi f).get i = f i := by change (Vector.ofFn f)[i.val] = f i rw [Vector.getElem_ofFn] @@ -56,12 +56,12 @@ def ofPi (f : Fin n → Coeff) : Poly Coeff n := /-- `Vector.get` after `Vector.ofFn`, stated at the concrete carrier boundary. Lean's core `ofFn` API is phrased using `GetElem`; this bridge keeps proof casts out of users of the polynomial representation. -/ -theorem get_vectorOfFn (f : Fin n → Coeff) (i : Fin n) : +lemma get_vectorOfFn (f : Fin n → Coeff) (i : Fin n) : (Vector.ofFn f).get i = f i := by change (Vector.ofFn f)[i.val] = f i rw [Vector.getElem_ofFn] -@[simp] theorem toPi_ofPi (f : Fin n → Coeff) : +@[simp] lemma toPi_ofPi (f : Fin n → Coeff) : toPi (ofPi f) = f := by funext i exact get_ofPi f i @@ -69,23 +69,23 @@ theorem get_vectorOfFn (f : Fin n → Coeff) (i : Fin n) : /-- Pointwise extensionality for `Poly`: two vector-backed polynomials with equal `Fin`-indexed entries are equal. Bridges core `Vector.ext` (stated in terms of `[i]`) into the `.get` style used throughout the lattice layer. -/ -theorem ext_get_eq {p q : Poly Coeff n} +lemma ext_get_eq {p q : Poly Coeff n} (h : ∀ i : Fin n, p.get i = q.get i) : p = q := Vector.ext fun i hi => h ⟨i, hi⟩ -@[simp] theorem ofPi_toPi (p : Poly Coeff n) : +@[simp] lemma ofPi_toPi (p : Poly Coeff n) : ofPi (toPi p) = p := ext_get_eq fun i => get_ofPi (toPi p) i /-- Reading a pointwise combination reads the corresponding entries. This is the `Fin`-indexed boundary lemma used by the concrete ring operations. -/ -@[simp] theorem get_zipWith (f : Coeff → Coeff → Coeff) (p q : Poly Coeff n) +@[simp] lemma get_zipWith (f : Coeff → Coeff → Coeff) (p q : Poly Coeff n) (i : Fin n) : (Vector.zipWith f p q).get i = f (p.get i) (q.get i) := by exact Vector.getElem_zipWith (f := f) (as := (show Vector Coeff n from p)) (bs := (show Vector Coeff n from q)) i.isLt /-- Reading a mapped polynomial reads and maps the corresponding entry. -/ -@[simp] theorem get_map (f : Coeff → Coeff) (p : Poly Coeff n) (i : Fin n) : +@[simp] lemma get_map (f : Coeff → Coeff) (p : Poly Coeff n) (i : Fin n) : (Vector.map f p).get i = f (p.get i) := by exact Vector.getElem_map (xs := (show Vector Coeff n from p)) f i.isLt @@ -120,11 +120,11 @@ instance [Inhabited Coeff] : Inhabited (Poly Coeff n) := instance [Repr Coeff] : Repr (Poly Coeff n) := inferInstanceAs (Repr (Vector Coeff n)) -@[simp] theorem Poly.get_add [Add Coeff] (f g : Poly Coeff n) (i : Fin n) : +@[simp] lemma Poly.get_add [Add Coeff] (f g : Poly Coeff n) (i : Fin n) : (f + g).get i = f.get i + g.get i := by exact Vector.getElem_add f g i.val i.isLt -@[simp] theorem Poly.get_sub [Sub Coeff] (f g : Poly Coeff n) (i : Fin n) : +@[simp] lemma Poly.get_sub [Sub Coeff] (f g : Poly Coeff n) (i : Fin n) : (f - g).get i = f.get i - g.get i := by exact Vector.getElem_sub f g i.val i.isLt @@ -195,15 +195,15 @@ section VectorRingSimp variable {Coeff : Type u} {n : Nat} -@[simp] theorem vectorBackend_coeff (p : Poly Coeff n) (i : Fin n) : +@[simp] lemma vectorBackend_coeff (p : Poly Coeff n) (i : Fin n) : (vectorBackend Coeff n).coeff p i = p.get i := rfl -@[simp] theorem Poly.get_zero [Zero Coeff] (i : Fin n) : (0 : Poly Coeff n).get i = 0 := by +@[simp] lemma Poly.get_zero [Zero Coeff] (i : Fin n) : (0 : Poly Coeff n).get i = 0 := by change (0 : Vector Coeff n)[i.val] = 0 exact Vector.getElem_zero i.val i.isLt /-- Coefficient-wise negation lemma for abstract `Poly` (not tied to a specific ring). -/ -@[simp] theorem Poly.get_neg [Neg Coeff] (f : Poly Coeff n) (i : Fin n) : +@[simp] lemma Poly.get_neg [Neg Coeff] (f : Poly Coeff n) (i : Fin n) : (-f).get i = -f.get i := by change (-(f : Vector Coeff n))[i.val] = -((f : Vector Coeff n))[i.val] exact Vector.getElem_neg f i.val i.isLt @@ -213,28 +213,28 @@ variable [CommRing Coeff] abbrev vRing (Coeff : Type u) [CommRing Coeff] (n : Nat) := vectorNegacyclicRing Coeff n -@[simp] theorem vectorRing_zero : +@[simp] lemma vectorRing_zero : (vectorNegacyclicRing Coeff n).zero = (0 : Poly Coeff n) := rfl -theorem vectorRing_zero_get (i : Fin n) : +lemma vectorRing_zero_get (i : Fin n) : ((vectorNegacyclicRing Coeff n).zero).get i = (0 : Coeff) := by exact Poly.get_zero i -@[simp] theorem vectorRing_one_get (i : Fin n) : +@[simp] lemma vectorRing_one_get (i : Fin n) : ((vectorNegacyclicRing Coeff n).one).get i = if i.val = 0 then 1 else 0 := by exact Poly.get_vectorOfFn (fun i : Fin n => if i.val = 0 then 1 else 0) i -@[simp] theorem vectorNegacyclicRing_mul : +@[simp] lemma vectorNegacyclicRing_mul : (vectorNegacyclicRing Coeff n).mul = negacyclicMul (vectorBackend Coeff n) := rfl -@[simp] theorem vectorNegacyclicRing_backend : +@[simp] lemma vectorNegacyclicRing_backend : (vectorNegacyclicRing Coeff n).backend = vectorBackend Coeff n := rfl -@[simp] theorem vectorRing_mul_apply (f g : (vectorNegacyclicRing Coeff n).Poly) : +@[simp] lemma vectorRing_mul_apply (f g : (vectorNegacyclicRing Coeff n).Poly) : f * g = negacyclicMul (vectorBackend Coeff n) f g := rfl /-- Concrete `Vector.get` form of the pure negacyclic multiplication law. -/ -@[simp] theorem vectorKernel_mul_get (f g : Poly Coeff n) (i : Fin n) : +@[simp] lemma vectorKernel_mul_get (f g : Poly Coeff n) (i : Fin n) : (negacyclicMul (vectorBackend Coeff n) f g).get i = negacyclicConvCoeff f.get g.get i := by exact negacyclicMul_coeff (vectorBackend Coeff n) f g i @@ -242,7 +242,7 @@ theorem vectorRing_zero_get (i : Fin n) : /-- Coefficient of a sum through the concrete vector backend (`Vector.instAdd`). Paired with `vectorNegacyclicRing_backend` so that both variants of `+` on `Poly Coeff n` are handled after the backend is normalised. -/ -theorem vectorBackend_add_coeff (f g : Poly Coeff n) (i : Fin n) : +lemma vectorBackend_add_coeff (f g : Poly Coeff n) (i : Fin n) : (vectorBackend Coeff n).coeff (f + g) i = (vectorBackend Coeff n).coeff f i + (vectorBackend Coeff n).coeff g i := by exact Poly.get_add f g i @@ -250,13 +250,13 @@ theorem vectorBackend_add_coeff (f g : Poly Coeff n) (i : Fin n) : /-- Coefficient of a ring-`+` sum through the vector backend, where `+` comes from `NegacyclicRing.instAddPoly`. Fires in downstream files where the carrier is spelled as `(vectorNegacyclicRing ...).Poly` rather than `Poly Coeff n`. -/ -@[simp] theorem vectorBackend_ring_add_coeff (f g : (vectorNegacyclicRing Coeff n).Poly) +@[simp] lemma vectorBackend_ring_add_coeff (f g : (vectorNegacyclicRing Coeff n).Poly) (i : Fin n) : (vectorBackend Coeff n).coeff (f + g) i = (vectorBackend Coeff n).coeff f i + (vectorBackend Coeff n).coeff g i := NegacyclicRing.coeff_add (vectorNegacyclicRing Coeff n) f g i -theorem vectorRing_mul_add_right (f g h : Poly Coeff n) : +lemma vectorRing_mul_add_right (f g h : Poly Coeff n) : (vRing Coeff n).mul f (g + h) = (vRing Coeff n).mul f g + (vRing Coeff n).mul f h := by apply Poly.ext_get_eq intro k @@ -267,12 +267,12 @@ theorem vectorRing_mul_add_right (f g h : Poly Coeff n) : rw [← Finset.sum_add_distrib]; congr 1; ext ij split_ifs <;> ring -theorem vectorBackend_sub_coeff (f g : Poly Coeff n) (i : Fin n) : +lemma vectorBackend_sub_coeff (f g : Poly Coeff n) (i : Fin n) : (vectorBackend Coeff n).coeff (f - g) i = (vectorBackend Coeff n).coeff f i - (vectorBackend Coeff n).coeff g i := by exact Poly.get_sub f g i -theorem vectorRing_mul_sub_right (f g h : Poly Coeff n) : +lemma vectorRing_mul_sub_right (f g h : Poly Coeff n) : (vRing Coeff n).mul f (g - h) = (vRing Coeff n).mul f g - (vRing Coeff n).mul f h := by apply Poly.ext_get_eq intro k @@ -283,7 +283,7 @@ theorem vectorRing_mul_sub_right (f g h : Poly Coeff n) : rw [← Finset.sum_sub_distrib]; congr 1; ext ij split_ifs <;> ring -theorem vectorRing_mul_comm (f g : Poly Coeff n) : +lemma vectorRing_mul_comm (f g : Poly Coeff n) : (vRing Coeff n).mul f g = (vRing Coeff n).mul g f := by apply Poly.ext_get_eq intro k @@ -305,15 +305,15 @@ theorem vectorRing_mul_comm (f g : Poly Coeff n) : simp only [Nat.add_comm b a] split_ifs <;> ring -@[simp] theorem vectorRing_add_get (f g : Poly Coeff n) (i : Fin n) : +@[simp] lemma vectorRing_add_get (f g : Poly Coeff n) (i : Fin n) : ((vectorNegacyclicRing Coeff n).add f g).get i = f.get i + g.get i := by exact Poly.get_zipWith (· + ·) f g i -@[simp] theorem vectorRing_sub_get (f g : Poly Coeff n) (i : Fin n) : +@[simp] lemma vectorRing_sub_get (f g : Poly Coeff n) (i : Fin n) : ((vectorNegacyclicRing Coeff n).sub f g).get i = f.get i - g.get i := by exact Poly.get_zipWith (· - ·) f g i -@[simp] theorem vectorRing_neg_get (f : Poly Coeff n) (i : Fin n) : +@[simp] lemma vectorRing_neg_get (f : Poly Coeff n) (i : Fin n) : ((vectorNegacyclicRing Coeff n).neg f).get i = -f.get i := by exact Poly.get_map Neg.neg f i diff --git a/src/Commons/Schemes/Signature/MLDSA/Arithmetic.lean b/src/Commons/Schemes/Signature/MLDSA/Arithmetic.lean index 06ed0fc..6f3bb32 100644 --- a/src/Commons/Schemes/Signature/MLDSA/Arithmetic.lean +++ b/src/Commons/Schemes/Signature/MLDSA/Arithmetic.lean @@ -129,7 +129,7 @@ def polyVecBounded {k : ℕ} (v : RqVec k) (b : ℕ) : Prop := /-- The ML-DSA centered infinity norm `polyNorm` agrees with the backend-generic `LatticeCrypto.cInfNorm` on the canonical vector backend. This is the bridge that lets the `polyNorm`-stated `Primitives.Laws` fields consume the `cInfNorm`-stated rounding lemmas. -/ -theorem polyNorm_eq_cInfNorm (f : Rq) : polyNorm f = LatticeCrypto.cInfNorm f := +lemma polyNorm_eq_cInfNorm (f : Rq) : polyNorm f = LatticeCrypto.cInfNorm f := LatticeCrypto.zmodPolyNormOps_cInfNorm f end Norms diff --git a/src/Commons/Schemes/Signature/MLDSA/Concrete/Encoding.lean b/src/Commons/Schemes/Signature/MLDSA/Concrete/Encoding.lean index 377f2ce..34c9363 100644 --- a/src/Commons/Schemes/Signature/MLDSA/Concrete/Encoding.lean +++ b/src/Commons/Schemes/Signature/MLDSA/Concrete/Encoding.lean @@ -90,20 +90,20 @@ def unpackNatArray (count width : Nat) (bytes : ByteArray) : Array Nat := Array.ofFn fun idx : Fin count => Nat.ofDigits 2 <| List.ofFn fun j : Fin width => bits.getD (idx.val * width + j.val) 0 -theorem bytesToBits_size (bytes : ByteArray) : +lemma bytesToBits_size (bytes : ByteArray) : (bytesToBits bytes).size = bytes.size * 8 := by simp [bytesToBits] -theorem bytesToBits_getElem (bytes : ByteArray) (i : Nat) +lemma bytesToBits_getElem (bytes : ByteArray) (i : Nat) (hi : i < (bytesToBits bytes).size) : (bytesToBits bytes)[i]'hi = bitOf (getByteD bytes (i / 8)) (i % 8) := by simp only [bytesToBits, Array.getElem_ofFn] -theorem unpackNatArray_size (count width : Nat) (bytes : ByteArray) : +lemma unpackNatArray_size (count width : Nat) (bytes : ByteArray) : (unpackNatArray count width bytes).size = count := by simp [unpackNatArray] -theorem unpackNatArray_getElem (count width : Nat) (bytes : ByteArray) (i : Nat) +lemma unpackNatArray_getElem (count width : Nat) (bytes : ByteArray) (i : Nat) (hi : i < (unpackNatArray count width bytes).size) : (unpackNatArray count width bytes)[i]'hi = Nat.ofDigits 2 (List.ofFn fun j : Fin width => @@ -142,18 +142,18 @@ the integer window `[b - (2^width - 1), b]`. For the FIPS-204 `z` range `[-γ₁ centered infinity norm of at most `γ₁`, independent of the (opaque) SHAKE byte input. -/ /-- Each `bitOf` value is a single bit, hence `< 2`. -/ -theorem bitOf_lt_two (b : UInt8) (j : Nat) : bitOf b j < 2 := by +lemma bitOf_lt_two (b : UInt8) (j : Nat) : bitOf b j < 2 := by unfold bitOf rw [UInt8.toNat_and, show (1 : UInt8).toNat = 1 from rfl, show (2 : ℕ) = 2 ^ 1 from rfl] exact Nat.and_lt_two_pow _ (by norm_num) /-- Total `Array.getD` lookup with a default agrees with indexing within bounds. -/ -theorem array_getD_eq_getElem {α : Type} (a : Array α) {i : Nat} +lemma array_getD_eq_getElem {α : Type} (a : Array α) {i : Nat} (fallback : α) (h : i < a.size) : a.getD i fallback = a[i] := by simp [Array.getD, h] /-- Every bit produced by `bytesToBits` is `< 2`. -/ -theorem bytesToBits_getD_lt_two (bytes : ByteArray) (i : Nat) : +lemma bytesToBits_getD_lt_two (bytes : ByteArray) (i : Nat) : (bytesToBits bytes).getD i 0 < 2 := by by_cases hi : i < (bytesToBits bytes).size · rw [array_getD_eq_getElem (a := bytesToBits bytes) (i := i) (fallback := 0) hi] @@ -164,7 +164,7 @@ theorem bytesToBits_getD_lt_two (bytes : ByteArray) (i : Nat) : /-- Each value produced by `unpackNatArray` at width `width` is `< 2 ^ width`: it is the `ofDigits` of `width` bits, each `< 2`. -/ -theorem unpackNatArray_getD_lt (count width : Nat) (bytes : ByteArray) (i : Nat) : +lemma unpackNatArray_getD_lt (count width : Nat) (bytes : ByteArray) (i : Nat) : (unpackNatArray count width bytes).getD i 0 < 2 ^ width := by by_cases hi : i < (unpackNatArray count width bytes).size · rw [array_getD_eq_getElem (a := unpackNatArray count width bytes) (i := i) (fallback := 0) hi] @@ -185,7 +185,7 @@ theorem unpackNatArray_getD_lt (count width : Nat) (bytes : ByteArray) (i : Nat) /-- The `i`-th coefficient of `bitUnpackPoly bytes a b` is `b - v` cast into `Coeff`, where `v` is a `width`-bit value (`width = rangeWidth a b`); in particular `0 ≤ v < 2 ^ width`. -/ -theorem bitUnpackPoly_get (bytes : ByteArray) (a b : ℤ) (i : Fin ringDegree) : +lemma bitUnpackPoly_get (bytes : ByteArray) (a b : ℤ) (i : Fin ringDegree) : ∃ v : ℕ, v < 2 ^ rangeWidth a b ∧ (bitUnpackPoly bytes a b).get i = ((b - (v : ℤ) : ℤ) : Coeff) := by refine ⟨(unpackNatArray ringDegree (rangeWidth a b) bytes).getD i.val 0, @@ -207,7 +207,7 @@ def packBitsList (vals : Array Nat) (width : Nat) : List Nat := (List.range width).map fun bit => (vals.getD i 0 / 2 ^ bit) % 2 /-- A `for`-loop over a list that appends a per-element list to the accumulator array. -/ -theorem forIn_push_flatten (l : List Nat) (g : Nat → List Nat) (a : Array Nat) : +lemma forIn_push_flatten (l : List Nat) (g : Nat → List Nat) (a : Array Nat) : (Id.run do let mut acc : Array Nat := a for i in l do @@ -263,7 +263,7 @@ theorem forIn_push_flatten (l : List Nat) (g : Nat → List Nat) (a : Array Nat) = Array.mk (g x) ++ Array.mk (xs.flatMap g) from by simp, Array.append_assoc] /-- The bytes produced by `packNatArray` are `bitsToBytes` applied to the little-endian bit list. -/ -theorem packNatArray_eq (vals : Array Nat) (width : Nat) : +lemma packNatArray_eq (vals : Array Nat) (width : Nat) : packNatArray vals width = bitsToBytes (Array.mk (packBitsList vals width)) := by unfold packNatArray packBitsList rw [show (Id.run do @@ -286,12 +286,12 @@ theorem packNatArray_eq (vals : Array Nat) (width : Nat) : simp [Array.mkEmpty] /-- Length of `packBitsList`: `vals.size` chunks of `width` bits each. -/ -theorem packBitsList_length (vals : Array Nat) (width : Nat) : +lemma packBitsList_length (vals : Array Nat) (width : Nat) : (packBitsList vals width).length = vals.size * width := by simp [packBitsList, List.length_flatMap, Nat.mul_comm] /-- The `(i * width + bit)`-th bit of `packBitsList vals width` is bit `bit` of `vals[i]`. -/ -theorem getD_flatMap_const_len {α} [Inhabited α] (n width : Nat) (h : Nat → Nat → α) +lemma getD_flatMap_const_len {α} [Inhabited α] (n width : Nat) (h : Nat → Nat → α) (i bit : Nat) (hi : i < n) (hbit : bit < width) : ((List.range n).flatMap fun i => (List.range width).map fun b => h i b).getD (i * width + bit) default = h i bit := by @@ -315,14 +315,14 @@ theorem getD_flatMap_const_len {α} [Inhabited α] (n width : Nat) (h : Nat → rw [List.getD_eq_getElem _ _ (by simp [hbit])] simp -theorem packBitsList_getD (vals : Array Nat) (width i bit : Nat) +lemma packBitsList_getD (vals : Array Nat) (width i bit : Nat) (hi : i < vals.size) (hbit : bit < width) : (packBitsList vals width).getD (i * width + bit) 0 = (vals.getD i 0 / 2 ^ bit) % 2 := getD_flatMap_const_len vals.size width (fun i b => (vals.getD i 0 / 2 ^ b) % 2) i bit hi hbit /-! ## `bitsToBytes` / `bytesToBits` roundtrip helpers (size a multiple of 8) -/ -theorem bitOf_packByte_fin : +lemma bitOf_packByte_fin : ∀ bits : Fin 8 → Fin 2, ∀ j : Fin 8, bitOf (packByte fun i => (bits i).val) j.val = (bits j).val := by intro bits j @@ -349,23 +349,23 @@ theorem bitOf_packByte_fin : Nat.ofDigits_div_pow_eq_ofDigits_drop j.val (by norm_num) digits hdigits, Nat.ofDigits_mod_eq_head!, hhead, Nat.mod_eq_of_lt (bits j).isLt] -theorem bytearray_mk_getByteD {arr : Array UInt8} {i : Nat} (h : i < arr.size) : +lemma bytearray_mk_getByteD {arr : Array UInt8} {i : Nat} (h : i < arr.size) : getByteD (ByteArray.mk arr) i = arr[i] := by unfold getByteD have hsz : i < (ByteArray.mk arr).size := by simpa [ByteArray.size] using h rw [getElem?_pos (ByteArray.mk arr) i hsz]; rfl -theorem getByteD_bitsToBytes (bits : Array Nat) (b : Nat) +lemma getByteD_bitsToBytes (bits : Array Nat) (b : Nat) (hb : b < (bits.size + 7) / 8) : getByteD (bitsToBytes bits) b = packByte fun j => bits.getD (8 * b + j.val) 0 := by unfold bitsToBytes rw [bytearray_mk_getByteD (by simpa using hb), Array.getElem_ofFn] -theorem bitsToBytes_size_of_mod (bits : Array Nat) (h : bits.size % 8 = 0) : +lemma bitsToBytes_size_of_mod (bits : Array Nat) (h : bits.size % 8 = 0) : (bitsToBytes bits).size = bits.size / 8 := by simp [bitsToBytes, ByteArray.size]; omega -theorem bytesToBits_bitsToBytes_getD {bits : Array Nat} {i : Nat} +lemma bytesToBits_bitsToBytes_getD {bits : Array Nat} {i : Nat} (hsize : bits.size % 8 = 0) (hbits : ∀ j, j < bits.size → bits.getD j 0 < 2) (hi : i < bits.size) : @@ -388,7 +388,7 @@ theorem bytesToBits_bitsToBytes_getD {bits : Array Nat} {i : Nat} /-! ## `Nat.ofDigits` bit-decomposition recovery -/ -theorem ofDigits_bits (v width : Nat) (hv : v < 2 ^ width) : +lemma ofDigits_bits (v width : Nat) (hv : v < 2 ^ width) : Nat.ofDigits 2 (List.ofFn fun j : Fin width => (v / 2 ^ j.val) % 2) = v := by induction width generalizing v with | zero => simp only [pow_zero] at hv; interval_cases v; simp @@ -408,7 +408,7 @@ theorem ofDigits_bits (v width : Nat) (hv : v < 2 ^ width) : /-- Generic `unpackNatArray ∘ packNatArray` roundtrip: at any index `i < vals.size`, decoding a `width`-bit packing recovers `vals[i]`, provided every entry fits in `width` bits and `vals.size * width` is a multiple of 8 (so the byte packing has no relevant padding). -/ -theorem unpackNatArray_packNatArray_getD (vals : Array Nat) (width i : Nat) +lemma unpackNatArray_packNatArray_getD (vals : Array Nat) (width i : Nat) (hi : i < vals.size) (hwpos : 0 < width) (hmod : vals.size * width % 8 = 0) (hvalsbnd : ∀ j, j < vals.size → vals.getD j 0 < 2 ^ width) : @@ -457,7 +457,7 @@ theorem unpackNatArray_packNatArray_getD (vals : Array Nat) (width i : Nat) /-- `simpleBitUnpackPoly` inverts `simpleBitPackPoly` on polynomials whose coefficients fit in `simpleWidth b` bits: `(f.get i).val < 2 ^ simpleWidth b` for all `i`. -/ -theorem simpleBitUnpackPoly_simpleBitPackPoly (f : Rq) (b : Nat) +lemma simpleBitUnpackPoly_simpleBitPackPoly (f : Rq) (b : Nat) (hf : ∀ i : Fin ringDegree, (f.get i).val < 2 ^ simpleWidth b) : simpleBitUnpackPoly (simpleBitPackPoly f b) b = f := by have hwpos : 0 < simpleWidth b := by unfold simpleWidth; omega @@ -555,7 +555,7 @@ back out. When the per-polynomial codec is a left inverse on the valid range, th too, hence `packPolyVector` is injective on valid vectors. -/ /-- Total `ByteArray` lookup agrees with the `toList` lookup. -/ -theorem ba_getElem?_getD (ba : ByteArray) (i : Nat) : +lemma ba_getElem?_getD (ba : ByteArray) (i : Nat) : ba[i]?.getD 0 = ba.data.toList[i]?.getD 0 := by have hlen : ba.data.toList.length = ba.size := by rw [Array.length_toList]; rfl by_cases h : i < ba.size @@ -565,14 +565,14 @@ theorem ba_getElem?_getD (ba : ByteArray) (i : Nat) : · rw [getElem?_neg ba i h, List.getElem?_eq_none_iff.mpr (by omega), Option.getD_none] /-- The size of `simpleBitPackPoly` is independent of the polynomial. -/ -theorem simpleBitPackPoly_size (f : Rq) (m : Nat) : +lemma simpleBitPackPoly_size (f : Rq) (m : Nat) : (simpleBitPackPoly f m).size = (ringDegree * simpleWidth m + 7) / 8 := by unfold simpleBitPackPoly rw [packNatArray_eq] simp only [bitsToBytes, ByteArray.size, Array.size_ofFn, List.size_toArray, packBitsList_length] /-- `(packPolyVector v pack).data.toList` is the concatenation of the per-element packings. -/ -theorem packPolyVector_data_toList {k : Nat} (v : Vector Rq k) (pack : Rq → ByteArray) : +lemma packPolyVector_data_toList {k : Nat} (v : Vector Rq k) (pack : Rq → ByteArray) : (packPolyVector v pack).data.toList = (v.toList.map fun f => (pack f).data.toList).flatten := by unfold packPolyVector concatByteArrays @@ -589,7 +589,7 @@ theorem packPolyVector_data_toList {k : Nat} (v : Vector Rq k) (pack : Rq → By simp only [List.nil_append, List.map_map] rfl -theorem getElem_flatten_const {α} (chunks : List (List α)) (sz : Nat) +lemma getElem_flatten_const {α} (chunks : List (List α)) (sz : Nat) (hsz : ∀ c ∈ chunks, c.length = sz) (i j : Nat) (hi : i < chunks.length) (hj : j < sz) : chunks.flatten[i * sz + j]? = (chunks[i]'hi)[j]? := by @@ -611,7 +611,7 @@ theorem getElem_flatten_const {α} (chunks : List (List α)) (sz : Nat) /-- Slicing chunk `i` out of `packPolyVector` recovers the `i`-th packing, when every chunk has the common size `chunkSize`. -/ -theorem sliceByteArray_packPolyVector {k : Nat} (v : Vector Rq k) (pack : Rq → ByteArray) +lemma sliceByteArray_packPolyVector {k : Nat} (v : Vector Rq k) (pack : Rq → ByteArray) (chunkSize : Nat) (hpack : ∀ f, (pack f).size = chunkSize) (i : Fin k) : sliceByteArray (packPolyVector v pack) (i.val * chunkSize) chunkSize = pack (v.get i) := by have hmkdata : ∀ a : Array UInt8, (ByteArray.mk a).data = a := fun _ => rfl @@ -640,7 +640,7 @@ theorem sliceByteArray_packPolyVector {k : Nat} (v : Vector Rq k) (pack : Rq → /-- `unpackPolyVector` inverts `packPolyVector` on vectors whose every component is fixed by the per-polynomial codec roundtrip. -/ -theorem unpackPolyVector_packPolyVector {k chunkSize : Nat} (v : Vector Rq k) +lemma unpackPolyVector_packPolyVector {k chunkSize : Nat} (v : Vector Rq k) (pack : Rq → ByteArray) (unpack : ByteArray → Rq) (hpack : ∀ f, (pack f).size = chunkSize) (hroundtrip : ∀ i : Fin k, unpack (pack (v.get i)) = v.get i) : @@ -659,7 +659,7 @@ def w1Encode (p : Params) (w1 : Vector High p.k) : List Byte := byteArrayToList (w1EncodeBytes p w1) /-- `byteArrayToList` is injective. -/ -theorem byteArrayToList_injective : Function.Injective byteArrayToList := by +lemma byteArrayToList_injective : Function.Injective byteArrayToList := by intro a b hab apply ByteArray.ext apply Array.ext' @@ -668,7 +668,7 @@ theorem byteArrayToList_injective : Function.Injective byteArrayToList := by /-- `w1Encode` is injective on the range of commitment vectors whose every coefficient fits in the `w₁` packer's bit width `simpleWidth ((q-1)/(2γ₂) - 1)`. The `w₁` packer is `simpleBitPackPoly` at that width, which is inverted by `simpleBitUnpackPoly` on this range. -/ -theorem w1Encode_injOn (p : Params) : +lemma w1Encode_injOn (p : Params) : Set.InjOn (w1Encode p) { w : Vector High p.k | ∀ i : Fin p.k, ∀ c : Fin ringDegree, ((w.get i).get c).val < 2 ^ simpleWidth ((modulus - 1) / (2 * p.gamma2) - 1) } := by @@ -813,14 +813,14 @@ def secretKeyBytes (p : Params) : Nat := def signatureBytes (p : Params) : Nat := p.lambda / 4 + p.l * polyZPackedBytes p + (p.omega + p.k) /-- The size of `bitPackPoly` is independent of the polynomial. -/ -theorem bitPackPoly_size (f : Rq) (a b : ℤ) : +lemma bitPackPoly_size (f : Rq) (a b : ℤ) : (bitPackPoly f a b).size = (ringDegree * rangeWidth a b + 7) / 8 := by unfold bitPackPoly rw [packNatArray_eq] simp only [bitsToBytes, ByteArray.size, Array.size_ofFn, List.size_toArray, packBitsList_length] /-- A vector of polynomials packed at `n` bytes each has `k · n` bytes. -/ -theorem packPolyVector_size {k : Nat} (v : Vector Rq k) (pack : Rq → ByteArray) {n : Nat} +lemma packPolyVector_size {k : Nat} (v : Vector Rq k) (pack : Rq → ByteArray) {n : Nat} (h : ∀ f, (pack f).size = n) : (packPolyVector v pack).size = k * n := by have hlen := congrArg List.length (packPolyVector_data_toList v pack) rw [Array.length_toList] at hlen @@ -831,40 +831,40 @@ theorem packPolyVector_size {k : Nat} (v : Vector Rq k) (pack : Rq → ByteArray exact h f rw [hconst, List.map_const', List.sum_replicate, Vector.length_toList, smul_eq_mul] -theorem polyT1Pack_size (f : Power2High) : (polyT1Pack f).size = polyT1PackedBytes := by +lemma polyT1Pack_size (f : Power2High) : (polyT1Pack f).size = polyT1PackedBytes := by rw [polyT1Pack, simpleBitPackPoly_size, polyT1PackedBytes, ringDegree] omega -theorem polyEtaPack_size (p : Params) (f : Rq) : (polyEtaPack p f).size = polyEtaPackedBytes p := by +lemma polyEtaPack_size (p : Params) (f : Rq) : (polyEtaPack p f).size = polyEtaPackedBytes p := by rw [polyEtaPack, bitPackPoly_size, polyEtaPackedBytes, ringDegree] omega -theorem polyT0Pack_size (f : Rq) : (polyT0Pack f).size = polyT0PackedBytes := by +lemma polyT0Pack_size (f : Rq) : (polyT0Pack f).size = polyT0PackedBytes := by rw [polyT0Pack, bitPackPoly_size, polyT0PackedBytes, ringDegree] omega -theorem polyZPack_size (p : Params) (f : Rq) : (polyZPack p f).size = polyZPackedBytes p := by +lemma polyZPack_size (p : Params) (f : Rq) : (polyZPack p f).size = polyZPackedBytes p := by rw [polyZPack, bitPackPoly_size, polyZPackedBytes, ringDegree] omega -theorem vectorToByteArray_size {n : Nat} (v : Bytes n) : (vectorToByteArray v).size = n := by +lemma vectorToByteArray_size {n : Nat} (v : Bytes n) : (vectorToByteArray v).size = n := by simp [vectorToByteArray, ByteArray.size] /-- An encoded public key has `publicKeyBytes p` bytes. -/ -theorem pkEncode_size (p : Params) (rho : Bytes 32) (t1 : Vector Power2High p.k) : +lemma pkEncode_size (p : Params) (rho : Bytes 32) (t1 : Vector Power2High p.k) : (pkEncode p rho t1).size = publicKeyBytes p := by rw [pkEncode, ByteArray.size_append, vectorToByteArray_size, packPolyVector_size _ _ polyT1Pack_size, publicKeyBytes] /-- An encoded secret key has `secretKeyBytes p` bytes. -/ -theorem skEncode_size (p : Params) (rho key : Bytes 32) (tr : Bytes 64) (s1 : RqVec p.l) +lemma skEncode_size (p : Params) (rho key : Bytes 32) (tr : Bytes 64) (s1 : RqVec p.l) (s2 t0 : RqVec p.k) : (skEncode p rho key tr s1 s2 t0).size = secretKeyBytes p := by simp only [skEncode, ByteArray.size_append, vectorToByteArray_size, packPolyVector_size _ _ (polyEtaPack_size p), packPolyVector_size _ _ polyT0Pack_size, secretKeyBytes] /-- An encoded signature has `signatureBytes p` bytes. -/ -theorem sigEncode_size (p : Params) (cTilde : CommitHashBytes p) (z : RqVec p.l) +lemma sigEncode_size (p : Params) (cTilde : CommitHashBytes p) (z : RqVec p.l) (h : Vector Hint p.k) : (sigEncode p cTilde z h).size = signatureBytes p := by rw [sigEncode, ByteArray.size_append, ByteArray.size_append, vectorToByteArray_size, packPolyVector_size _ _ (polyZPack_size p), vectorToByteArray_size, signatureBytes] @@ -881,7 +881,7 @@ is purely about the decoder's output range and holds for any byte input. -/ /-- Decode-range infinity-norm bound for a `z`-range `bitUnpackPoly`: every coefficient of `bitUnpackPoly bytes (-γ + 1) γ` has centered absolute value at most `γ`, provided the bit width satisfies `2 ^ width = 2 γ` (true for FIPS-204 `γ₁`, a power of two) and `2 γ < q`. -/ -theorem bitUnpackPoly_z_cInfNorm_le (bytes : ByteArray) (γ : ℕ) +lemma bitUnpackPoly_z_cInfNorm_le (bytes : ByteArray) (γ : ℕ) (hwidth : (2 : ℕ) ^ rangeWidth (-(γ : ℤ) + 1) (γ : ℤ) = 2 * γ) (hq : 2 * γ < modulus) : LatticeCrypto.cInfNorm (bitUnpackPoly bytes (-(γ : ℤ) + 1) (γ : ℤ)) ≤ γ := by @@ -895,7 +895,7 @@ theorem bitUnpackPoly_z_cInfNorm_le (bytes : ByteArray) (γ : ℕ) /-- For each approved parameter set the `z`-range bit width satisfies `2 ^ width = 2 γ₁` (because `γ₁` is a power of two) and `2 γ₁ < q`. -/ -theorem approved_gamma1_width (p : Params) (hp : p.isApproved) : +lemma approved_gamma1_width (p : Params) (hp : p.isApproved) : (2 : ℕ) ^ rangeWidth (-(p.gamma1 : ℤ) + 1) (p.gamma1 : ℤ) = 2 * p.gamma1 ∧ 2 * p.gamma1 < modulus := by rcases hp with rfl | rfl | rfl <;> exact ⟨rfl, by norm_num [mldsa44, mldsa65, mldsa87, ParameterSet.params, modulus]⟩ diff --git a/src/Commons/Schemes/Signature/MLDSA/Concrete/Laws.lean b/src/Commons/Schemes/Signature/MLDSA/Concrete/Laws.lean index 48e74f7..904f74b 100644 --- a/src/Commons/Schemes/Signature/MLDSA/Concrete/Laws.lean +++ b/src/Commons/Schemes/Signature/MLDSA/Concrete/Laws.lean @@ -28,7 +28,7 @@ attribute [local instance] concreteNTTRingOps variable (p : Params) /-- `Primitives.Laws.transform` for the concrete instance. -/ -theorem concrete_transform : NTTRingLaws concreteNTTRingOps := +lemma concrete_transform : NTTRingLaws concreteNTTRingOps := concreteNTTRingLaws /-! ## Bit-width fit for the `w₁` packer @@ -40,7 +40,7 @@ which fits in that bit width, so the packer is inverted by `simpleBitUnpackPoly` there. -/ /-- Every approved-parameter `highBits` coefficient fits in the `w₁` packer's bit width. -/ -theorem highBits_coeff_val_lt_width (hp : p.isApproved) (r : Rq) (c : Fin ringDegree) : +lemma highBits_coeff_val_lt_width (hp : p.isApproved) (r : Rq) (c : Fin ringDegree) : ((MLDSA.Concrete.highBits p r).get c).val < 2 ^ MLDSA.Concrete.simpleWidth ((modulus - 1) / (2 * p.gamma2) - 1) := by have hlt : ((MLDSA.Concrete.highBits p r).get c).val < (modulus - 1) / (2 * p.gamma2) := @@ -55,20 +55,20 @@ theorem highBits_coeff_val_lt_width (hp : p.isApproved) (r : Rq) (c : Fin ringDe /-! ## Provable algebraic fields (banked) -/ /-- `Primitives.Laws.high_low_decomp` for the concrete instance. -/ -theorem concrete_high_low_decomp (r : Rq) : +lemma concrete_high_low_decomp (r : Rq) : (concretePrimitives p).highBitsShift ((concretePrimitives p).highBits r) + (concretePrimitives p).lowBits r = r := concreteRounding_high_low_decomp p r /-- `Primitives.Laws.lowBits_bound` for the concrete instance (approved parameters). -/ -theorem concrete_lowBits_bound (hp : p.isApproved) (r : Rq) : +lemma concrete_lowBits_bound (hp : p.isApproved) (r : Rq) : polyNorm ((concretePrimitives p).lowBits r) ≤ p.gamma2 := by rw [polyNorm_eq_cInfNorm] exact concreteRounding_lowBits_bound p (by rcases hp with rfl | rfl | rfl <;> norm_num [mldsa44, mldsa65, mldsa87, ParameterSet.params, modulus]) (by rcases hp with rfl | rfl | rfl <;> norm_num [mldsa44, mldsa65, mldsa87, ParameterSet.params, modulus]) r /-- `Primitives.Laws.hide_low` for the concrete instance (approved parameters). -/ -theorem concrete_hide_low (hp : p.isApproved) (r s : Rq) (b : ℕ) +lemma concrete_hide_low (hp : p.isApproved) (r s : Rq) (b : ℕ) (hs : polyNorm s ≤ b) (hlow : polyNorm ((concretePrimitives p).lowBits r) + b < p.gamma2) : (concretePrimitives p).highBits (r + s) = (concretePrimitives p).highBits r := by @@ -77,25 +77,25 @@ theorem concrete_hide_low (hp : p.isApproved) (r s : Rq) (b : ℕ) · rw [← polyNorm_eq_cInfNorm]; exact hlow /-- `Primitives.Laws.highBitsShift_injective` for the concrete instance (approved parameters). -/ -theorem concrete_highBitsShift_injective (hp : p.isApproved) : +lemma concrete_highBitsShift_injective (hp : p.isApproved) : Function.Injective (concretePrimitives p).highBitsShift := highBitsShift_injective_of_isApproved p hp /-- `Primitives.Laws.useHint_makeHint` for the concrete instance (approved parameters). -/ -theorem concrete_useHint_makeHint (hp : p.isApproved) (z r : Rq) (hz : polyNorm z ≤ p.gamma2) : +lemma concrete_useHint_makeHint (hp : p.isApproved) (z r : Rq) (hz : polyNorm z ≤ p.gamma2) : (concretePrimitives p).useHint ((concretePrimitives p).makeHint z r) r = (concretePrimitives p).highBits (r + z) := by apply concreteRounding_useHint_correct_of_isApproved p hp z r rwa [← polyNorm_eq_cInfNorm] /-- `Primitives.Laws.power2Round_decomp` for the concrete instance. -/ -theorem concrete_power2Round_decomp (r : Rq) : +lemma concrete_power2Round_decomp (r : Rq) : (concretePrimitives p).power2RoundShift ((concretePrimitives p).power2Round r).1 + ((concretePrimitives p).power2Round r).2 = r := concretePower2Round_high_low_decomp r /-- `Primitives.Laws.power2Round_bound` for the concrete instance. -/ -theorem concrete_power2Round_bound (r : Rq) : +lemma concrete_power2Round_bound (r : Rq) : polyNorm ((concretePrimitives p).power2Round r).2 ≤ 2 ^ (droppedBits - 1) := by rw [polyNorm_eq_cInfNorm] change LatticeCrypto.cInfNorm (power2RoundLow r) ≤ 2 ^ (droppedBits - 1) @@ -111,7 +111,7 @@ after generalizing the byte argument; the two side conditions on the `z`-range b /-- `Primitives.Laws.expandMask_bound` (bound `γ₁`) for the concrete instance, at any approved parameter set. -/ -theorem concrete_expandMask_bound (hp : p.isApproved) (rhoDoublePrime : Bytes 64) (kappa : ℕ) : +lemma concrete_expandMask_bound (hp : p.isApproved) (rhoDoublePrime : Bytes 64) (kappa : ℕ) : polyVecBounded ((concretePrimitives p).expandMask rhoDoublePrime kappa) p.gamma1 := by rw [polyVecBounded, polyVecNorm, LatticeCrypto.PolyVec.cInfNorm_le_iff] intro j @@ -129,7 +129,7 @@ field, since the abstract validity set is the image of `highBits`. -/ /-- `Primitives.Laws.w1Encode_injective` for the concrete instance, at any approved parameter set: `w1Encode` is injective on commitment vectors all of whose components are `highBits` outputs. -/ -theorem concrete_w1Encode_injOn (hp : p.isApproved) : +lemma concrete_w1Encode_injOn (hp : p.isApproved) : Set.InjOn (concretePrimitives p).w1Encode { w : Vector (concretePrimitives p).High p.k | ∀ i : Fin p.k, w.get i ∈ Set.range (concretePrimitives p).highBits } := by @@ -152,13 +152,13 @@ them at the `concretePrimitives` interface. -/ /-- `Primitives.Laws.sampleInBall_norm` for the concrete instance: `SampleInBall(c̃)` has centered infinity norm at most `1` (its coefficients lie in `{-1, 0, +1}`). -/ -theorem concrete_sampleInBall_norm (cTilde : CommitHashBytes p) : +lemma concrete_sampleInBall_norm (cTilde : CommitHashBytes p) : polyNorm ((concretePrimitives p).sampleInBall cTilde) ≤ 1 := MLDSA.Concrete.sampleInBall_norm p cTilde /-- `Primitives.Laws.expandS_bound` for the concrete instance: `ExpandS(ρ')` produces secret vectors with every coefficient bounded by `η`. -/ -theorem concrete_expandS_bound (rhoPrime : Bytes 64) : +lemma concrete_expandS_bound (rhoPrime : Bytes 64) : polyVecBounded ((concretePrimitives p).expandS rhoPrime).1 p.eta ∧ polyVecBounded ((concretePrimitives p).expandS rhoPrime).2 p.eta := MLDSA.Concrete.expandS_bound rhoPrime p @@ -168,7 +168,7 @@ product `c · sⱼ` has centered infinity norm at most `β = τ · η` whenever the generic negacyclic-convolution bound `‖c · sⱼ‖∞ ≤ ‖c‖₁ · ‖sⱼ‖∞` (`cInfNorm_mul_le`), the challenge `ℓ₁` count `‖SampleInBall(c̃)‖₁ ≤ τ` (`sampleInBall_l1Norm`), and the component law `(c • s).get j = c * sⱼ` (`coeffScalarVecMul_get`). -/ -theorem concrete_sampleInBall_smul_bound +lemma concrete_sampleInBall_smul_bound (cTilde : CommitHashBytes p) {k : ℕ} (s : RqVec k) (hs : polyVecBounded s p.eta) : polyVecNorm (concreteNTTRingOps.coeffScalarVecMul @@ -195,7 +195,7 @@ theorem concrete_sampleInBall_smul_bound /-! ## The laws and correctness -/ /-- **The laws of the concrete ML-DSA primitives**, at every approved parameter set. -/ -theorem concretePrimitives_laws (hp : p.isApproved) : +lemma concretePrimitives_laws (hp : p.isApproved) : Primitives.Laws (concretePrimitives p) concreteNTTRingOps where sampleInBall_norm := concrete_sampleInBall_norm p expandS_bound := concrete_expandS_bound p diff --git a/src/Commons/Schemes/Signature/MLDSA/Concrete/NTT.lean b/src/Commons/Schemes/Signature/MLDSA/Concrete/NTT.lean index f31d7a9..57749a1 100644 --- a/src/Commons/Schemes/Signature/MLDSA/Concrete/NTT.lean +++ b/src/Commons/Schemes/Signature/MLDSA/Concrete/NTT.lean @@ -57,31 +57,31 @@ def nInv : Coeff := ((modulus - (modulus - 1) / ringDegree : ℕ) : Coeff) /-- Safe array access with fallback to zero. -/ def getZ (a : Array Coeff) (i : Nat) : Coeff := a.getD i 0 -theorem bitRev8_layer_partner : +lemma bitRev8_layer_partner : ∀ (s : Fin 8) (g : Fin (2 ^ s.val)), bitRev8 (2 ^ s.val + g.val) + bitRev8 (2 ^ (s.val + 1) - 1 - g.val) = 256 := by intro s g fin_cases s <;> fin_cases g <;> rfl -theorem layer_twiddle_index_bounds : +lemma layer_twiddle_index_bounds : ∀ (s : Fin 8) (g : Fin (2 ^ s.val)), 2 ^ s.val + g.val < 256 ∧ 2 ^ (s.val + 1) - 1 - g.val < 256 := by intro s g fin_cases s <;> fin_cases g <;> norm_num -theorem getZ_zetaTable (i : Nat) (hi : i < 256) : +lemma getZ_zetaTable (i : Nat) (hi : i < 256) : getZ zetaTable i = zeta ^ bitRev8 i := by simp [getZ, zetaTable, hi] -theorem zeta_pow_256 : (zeta : Coeff) ^ 256 = -1 := by +lemma zeta_pow_256 : (zeta : Coeff) ^ 256 = -1 := by change (1753 : ZMod 8380417) ^ 256 = -1 reduce_mod_char /-- `ζ = 1753` is a primitive `512`-th root of unity in `ℤ_q` (FIPS 204 §7.5): the twiddle half of the NTT correctness argument. -/ -theorem zeta_isPrimitiveRoot : IsPrimitiveRoot (zeta : Coeff) 512 := by +lemma zeta_isPrimitiveRoot : IsPrimitiveRoot (zeta : Coeff) 512 := by change IsPrimitiveRoot (1753 : ZMod 8380417) 512 rw [IsPrimitiveRoot.iff_orderOf] refine orderOf_eq_of_pow_and_pow_div_prime (by norm_num) (by reduce_mod_char) ?_ @@ -92,7 +92,7 @@ theorem zeta_isPrimitiveRoot : IsPrimitiveRoot (zeta : Coeff) 512 := by exact ne_of_beq_false rfl /-- Forward and complementary inverse-table twiddles in one layer multiply to `-1`. -/ -theorem zetaTable_layer_partner : +lemma zetaTable_layer_partner : ∀ (s : Fin 8) (g : Fin (2 ^ s.val)), getZ zetaTable (2 ^ s.val + g.val) * getZ zetaTable (2 ^ (s.val + 1) - 1 - g.val) = -1 := by @@ -101,7 +101,7 @@ theorem zetaTable_layer_partner : rw [getZ_zetaTable _ hforward, getZ_zetaTable _ hinverse, ← pow_add] rw [bitRev8_layer_partner s g, zeta_pow_256] -theorem layer_shape : +lemma layer_shape : ∀ s : Fin 8, 2 ^ s.val * (2 * (128 / 2 ^ s.val)) = polyBackend.degree := by intro s fin_cases s <;> rfl @@ -135,7 +135,7 @@ def nttStages : [nttStage 0, nttStage 1, nttStage 2, nttStage 3, nttStage 4, nttStage 5, nttStage 6, nttStage 7] -theorem nInv_stageScalar : +lemma nInv_stageScalar : nInv * LatticeCrypto.NTTCert.stageScalar nttStages = 1 := by change ((8347681 * 256 : Nat) : ZMod 8380417) = ((1 : Nat) : ZMod 8380417) rw [ZMod.natCast_eq_natCast_iff'] @@ -147,23 +147,23 @@ def invNTTCoeffs (input : NTTCoord → Coeff) : NTTCoord → Coeff := LatticeCrypto.NTTCert.scaleCoeffs nInv (LatticeCrypto.NTTCert.inverseStages nttStages input) -theorem invNTTCoeffs_nttCoeffs (input : NTTCoord → Coeff) : +lemma invNTTCoeffs_nttCoeffs (input : NTTCoord → Coeff) : invNTTCoeffs (nttCoeffs input) = input := by unfold invNTTCoeffs nttCoeffs exact LatticeCrypto.NTTCert.scale_inverseStages_forwardStages nttStages nInv nInv_stageScalar input -theorem nttCoeffs_add (left right : NTTCoord → Coeff) : +lemma nttCoeffs_add (left right : NTTCoord → Coeff) : nttCoeffs (left + right) = nttCoeffs left + nttCoeffs right := by unfold nttCoeffs exact LatticeCrypto.NTTCert.forwardStages_add nttStages left right -theorem nttCoeffs_sub (left right : NTTCoord → Coeff) : +lemma nttCoeffs_sub (left right : NTTCoord → Coeff) : nttCoeffs (left - right) = nttCoeffs left - nttCoeffs right := by unfold nttCoeffs exact LatticeCrypto.NTTCert.forwardStages_sub nttStages left right -theorem nttCoeffs_zero : nttCoeffs 0 = 0 := by +lemma nttCoeffs_zero : nttCoeffs 0 = 0 := by unfold nttCoeffs exact LatticeCrypto.NTTCert.forwardStages_zero nttStages @@ -174,11 +174,11 @@ of its modulus `X^(256/2^s) - ζ^e`, with `e = 2·BitRev₈(2^s + g)`; after all is the input at `ζ^{2·BitRev₈(i)+1}`, a root of `X^256 + 1`, so the NTT turns negacyclic products into pointwise products. -/ -theorem layerLayout_left_val (s : Fin 8) (g : Fin (2 ^ s.val)) (j : Fin (128 / 2 ^ s.val)) : +lemma layerLayout_left_val (s : Fin 8) (g : Fin (2 ^ s.val)) (j : Fin (128 / 2 ^ s.val)) : ((layerLayout s).equiv ((g, j), false)).val = g.val * (2 * (128 / 2 ^ s.val)) + j.val := by simp [layerLayout] -theorem layerLayout_right_val (s : Fin 8) (g : Fin (2 ^ s.val)) (j : Fin (128 / 2 ^ s.val)) : +lemma layerLayout_right_val (s : Fin 8) (g : Fin (2 ^ s.val)) (j : Fin (128 / 2 ^ s.val)) : ((layerLayout s).equiv ((g, j), true)).val = g.val * (2 * (128 / 2 ^ s.val)) + 128 / 2 ^ s.val + j.val := by simp [layerLayout] @@ -188,14 +188,14 @@ coordinate `i` evaluates at `ζ^{2·BitRev₈(i)+1}`. -/ def rootExponent (s g : ℕ) : ℕ := if s < 8 then 2 * bitRev8 (2 ^ s + g) else 2 * bitRev8 g + 1 -theorem rootExponent_children : +lemma rootExponent_children : ∀ (s : Fin 8) (g : Fin (2 ^ s.val)), rootExponent (s.val + 1) (2 * g.val) % 512 = bitRev8 (2 ^ s.val + g.val) % 512 ∧ rootExponent (s.val + 1) (2 * g.val + 1) % 512 = (bitRev8 (2 ^ s.val + g.val) + 256) % 512 := by intro s g fin_cases s <;> fin_cases g <;> exact ⟨rfl, rfl⟩ -theorem zeta_pow_mod (a : ℕ) : (zeta : Coeff) ^ a = zeta ^ (a % 512) := by +lemma zeta_pow_mod (a : ℕ) : (zeta : Coeff) ^ a = zeta ^ (a % 512) := by conv_lhs => rw [← Nat.mod_add_div a 512] rw [pow_add, pow_mul, zeta_isPrimitiveRoot.pow_eq_one, one_pow, mul_one] @@ -206,13 +206,13 @@ def EvalInvariant (s : ℕ) (a f : NTTCoord → Coeff) : Prop := ω ^ (256 / 2 ^ s) = algebraMap Coeff S (zeta ^ rootExponent s g) → LatticeCrypto.NTTCert.segmentEval a (g * (256 / 2 ^ s)) (256 / 2 ^ s) ω = LatticeCrypto.NTTCert.segmentEval f 0 256 ω -theorem evalInvariant_zero (f : NTTCoord → Coeff) : EvalInvariant 0 f f := by +lemma evalInvariant_zero (f : NTTCoord → Coeff) : EvalInvariant 0 f f := by intro g hg S _ _ ω _ obtain rfl : g = 0 := by simpa using hg simp /-- **One layer preserves the invariant.** -/ -theorem evalInvariant_step (s : Fin 8) {a f : NTTCoord → Coeff} (h : EvalInvariant s.val a f) : +lemma evalInvariant_step (s : Fin 8) {a f : NTTCoord → Coeff} (h : EvalInvariant s.val a f) : EvalInvariant (s.val + 1) ((nttStage s).forward a) f := by intro g' hg' S _ _ ω hω have hB : 256 / 2 ^ s.val = 2 * (128 / 2 ^ s.val) := by fin_cases s <;> rfl @@ -266,7 +266,7 @@ theorem evalInvariant_step (s : Fin 8) {a f : NTTCoord → Coeff} (h : EvalInvar exact h g hg S ω (hparent (Or.inr hω')) /-- The invariant after all eight layers. -/ -theorem evalInvariant_nttCoeffs (f : NTTCoord → Coeff) : EvalInvariant 8 (nttCoeffs f) f := by +lemma evalInvariant_nttCoeffs (f : NTTCoord → Coeff) : EvalInvariant 8 (nttCoeffs f) f := by have h1 := evalInvariant_step 0 (evalInvariant_zero f) have h2 := evalInvariant_step 1 h1 have h3 := evalInvariant_step 2 h2 @@ -278,7 +278,7 @@ theorem evalInvariant_nttCoeffs (f : NTTCoord → Coeff) : EvalInvariant 8 (nttC /-- **The NTT evaluates** (FIPS 204, §7.5): coordinate `i` of `nttCoeffs f` is `f` at `ζ^{2·BitRev₈(i)+1}`. -/ -theorem nttCoeffs_apply (f : NTTCoord → Coeff) (i : NTTCoord) : +lemma nttCoeffs_apply (f : NTTCoord → Coeff) (i : NTTCoord) : nttCoeffs f i = LatticeCrypto.NTTCert.segmentEval f 0 256 (zeta ^ (2 * bitRev8 i.val + 1)) := by have h := evalInvariant_nttCoeffs f i.val i.isLt Coeff @@ -287,11 +287,11 @@ theorem nttCoeffs_apply (f : NTTCoord → Coeff) (i : NTTCoord) : simp [LatticeCrypto.NTTCert.segmentEval, LatticeCrypto.NTTCert.coeffAt] /-- The roots of the NTT satisfy `ω ^ 256 = -1`. -/ -theorem nttRoot_pow_256 (i : ℕ) : ((zeta : Coeff) ^ (2 * bitRev8 i + 1)) ^ 256 = -1 := by +lemma nttRoot_pow_256 (i : ℕ) : ((zeta : Coeff) ^ (2 * bitRev8 i + 1)) ^ 256 = -1 := by rw [← pow_mul, mul_comm, pow_mul, zeta_pow_256, (odd_two_mul_add_one _).neg_one_pow] /-- **The NTT turns negacyclic products into pointwise products.** -/ -theorem nttCoeffs_negacyclicConv (f g : NTTCoord → Coeff) (i : NTTCoord) : +lemma nttCoeffs_negacyclicConv (f g : NTTCoord → Coeff) (i : NTTCoord) : nttCoeffs (fun k => LatticeCrypto.negacyclicConvCoeff f g k) i = nttCoeffs f i * nttCoeffs g i := by rw [nttCoeffs_apply, nttCoeffs_apply, nttCoeffs_apply] exact LatticeCrypto.NTTCert.segmentEval_negacyclicConv f g _ (nttRoot_pow_256 i.val) @@ -310,13 +310,13 @@ def invNTT (fHat : Tq) : Rq := (Vector.ofFn (polyBackend.coeff fHat.coeffs))).get) /-- The NTT is the stage composite `nttCoeffs` on coefficient functions. -/ -theorem ntt_eq (f : Rq) : +lemma ntt_eq (f : Rq) : ntt f = ⟨LatticeCrypto.NTTCert.applyCoeffTransform polyBackend nttCoeffs f⟩ := by simp only [ntt, LatticeCrypto.NTTCert.applyCoeffTransform, nttCoeffs, LatticeCrypto.NTTCert.forwardStagesVec_get, LatticeCrypto.NTTCert.get_ofFn] /-- The inverse NTT is the stage composite `invNTTCoeffs` on coefficient functions. -/ -theorem invNTT_eq (fHat : Tq) : +lemma invNTT_eq (fHat : Tq) : invNTT fHat = LatticeCrypto.NTTCert.applyCoeffTransform polyBackend invNTTCoeffs fHat.coeffs := by simp only [invNTT, LatticeCrypto.NTTCert.applyCoeffTransform, invNTTCoeffs, LatticeCrypto.NTTCert.inverseStagesVec_get, LatticeCrypto.NTTCert.get_ofFn] @@ -326,7 +326,7 @@ def multiplyNTT (fHat gHat : Tq) : Tq := ⟨polyBackend.build fun i => polyBackend.coeff fHat.coeffs i * polyBackend.coeff gHat.coeffs i⟩ /-- The concrete inverse transform is a left inverse to the concrete forward transform. -/ -theorem invNTT_ntt (f : Rq) : invNTT (ntt f) = f := by +lemma invNTT_ntt (f : Rq) : invNTT (ntt f) = f := by rw [invNTT_eq, ntt_eq] exact LatticeCrypto.NTTCert.applyCoeffTransform_comp nttCoeffs invNTTCoeffs invNTTCoeffs_nttCoeffs f @@ -348,12 +348,12 @@ def rqEquivTq : Rq ≃ Tq where left_inv _ := rfl right_inv fHat := by cases fHat; rfl -theorem ntt_injective : Function.Injective ntt := by +lemma ntt_injective : Function.Injective ntt := by intro f g h have hInv := congrArg invNTT h simpa [invNTT_ntt] using hInv -theorem ntt_surjective : Function.Surjective ntt := by +lemma ntt_surjective : Function.Surjective ntt := by let : NeZero modulus := ⟨by norm_num [modulus]⟩ let : Fintype Coeff := by dsimp [Coeff] @@ -369,53 +369,53 @@ theorem ntt_invNTT (fHat : Tq) : ntt (invNTT fHat) = fHat := by _ = ntt f := by rw [invNTT_ntt] _ = fHat := hf -theorem hadd_rq (f g : Rq) : +lemma hadd_rq (f g : Rq) : polyBackend.coeff (f + g) = polyBackend.coeff f + polyBackend.coeff g := by funext i change ((LatticeCrypto.vectorNegacyclicRing Coeff ringDegree).add f g).get i = f.get i + g.get i simp -theorem hsub_rq (f g : Rq) : +lemma hsub_rq (f g : Rq) : polyBackend.coeff (f - g) = polyBackend.coeff f - polyBackend.coeff g := by funext i change ((LatticeCrypto.vectorNegacyclicRing Coeff ringDegree).sub f g).get i = f.get i - g.get i simp -theorem hzero_rq : polyBackend.coeff (0 : Rq) = 0 := by +lemma hzero_rq : polyBackend.coeff (0 : Rq) = 0 := by funext i exact LatticeCrypto.vectorRing_zero_get i /-- The concrete NTT is additive. -/ -theorem ntt_add_toRq (f g : Rq) : (ntt (f + g) : Rq) = (ntt f : Rq) + (ntt g : Rq) := by +lemma ntt_add_toRq (f g : Rq) : (ntt (f + g) : Rq) = (ntt f : Rq) + (ntt g : Rq) := by rw [ntt_eq, ntt_eq, ntt_eq] exact LatticeCrypto.NTTCert.applyCoeffTransform_add nttCoeffs hadd_rq nttCoeffs_add f g /-- The concrete NTT is additive. -/ -theorem ntt_add (f g : Rq) : ntt (f + g) = ntt f + ntt g := by +lemma ntt_add (f g : Rq) : ntt (f + g) = ntt f + ntt g := by apply LatticeCrypto.TransformPoly.ext change (ntt (f + g) : Rq) = (ntt f : Rq) + (ntt g : Rq) exact ntt_add_toRq f g /-- The concrete NTT preserves subtraction. -/ -theorem ntt_sub_toRq (f g : Rq) : (ntt (f - g) : Rq) = (ntt f : Rq) - (ntt g : Rq) := by +lemma ntt_sub_toRq (f g : Rq) : (ntt (f - g) : Rq) = (ntt f : Rq) - (ntt g : Rq) := by rw [ntt_eq, ntt_eq, ntt_eq] exact LatticeCrypto.NTTCert.applyCoeffTransform_sub nttCoeffs hsub_rq nttCoeffs_sub f g /-- The concrete NTT preserves subtraction. -/ -theorem ntt_sub (f g : Rq) : ntt (f - g) = ntt f - ntt g := by +lemma ntt_sub (f g : Rq) : ntt (f - g) = ntt f - ntt g := by apply LatticeCrypto.TransformPoly.ext change (ntt (f - g) : Rq) = (ntt f : Rq) - (ntt g : Rq) exact ntt_sub_toRq f g -theorem invNTT_add (g h : Tq) : invNTT (g + h) = invNTT g + invNTT h := by +lemma invNTT_add (g h : Tq) : invNTT (g + h) = invNTT g + invNTT h := by apply ntt_injective rw [ntt_invNTT, ntt_add, ntt_invNTT, ntt_invNTT] -theorem invNTT_sub (g h : Tq) : invNTT (g - h) = invNTT g - invNTT h := by +lemma invNTT_sub (g h : Tq) : invNTT (g - h) = invNTT g - invNTT h := by apply ntt_injective rw [ntt_invNTT, ntt_sub, ntt_invNTT, ntt_invNTT] -theorem negacyclicMul_coeff (a b : Rq) (k : Fin ringDegree) : +lemma negacyclicMul_coeff (a b : Rq) (k : Fin ringDegree) : polyBackend.coeff (negacyclicMul a b) k = LatticeCrypto.negacyclicConvCoeff (polyBackend.coeff a) (polyBackend.coeff b) k := LatticeCrypto.negacyclicMul_coeff polyBackend a b k @@ -434,7 +434,7 @@ theorem ntt_negacyclicMul (f g : Rq) : ntt (negacyclicMul f g) = multiplyNTT (nt exact nttCoeffs_negacyclicConv _ _ i /-- The pointwise product is the negacyclic product transported through the NTT. -/ -theorem multiplyNTT_eq (fHat gHat : Tq) : +lemma multiplyNTT_eq (fHat gHat : Tq) : multiplyNTT fHat gHat = ntt (negacyclicMul (invNTT fHat) (invNTT gHat)) := by rw [ntt_negacyclicMul, ntt_invNTT, ntt_invNTT] @@ -445,7 +445,7 @@ theorem multiplyNTT_eq (fHat gHat : Tq) : mulHat := multiplyNTT /-- Proof-oriented algebraic laws for the ML-DSA concrete NTT. -/ -theorem concreteNTTRingLaws : NTTRingLaws concreteNTTRingOps where +lemma concreteNTTRingLaws : NTTRingLaws concreteNTTRingOps where fromHat_toHat := invNTT_ntt toHat_fromHat := ntt_invNTT toHat_zero := by diff --git a/src/Commons/Schemes/Signature/MLDSA/Concrete/Rounding.lean b/src/Commons/Schemes/Signature/MLDSA/Concrete/Rounding.lean index a7e5a6b..faf4c2e 100644 --- a/src/Commons/Schemes/Signature/MLDSA/Concrete/Rounding.lean +++ b/src/Commons/Schemes/Signature/MLDSA/Concrete/Rounding.lean @@ -137,18 +137,18 @@ def useHint (p : Params) (h : Hint) (r : Rq) : High := def hintWeight (h : Hint) : ℕ := h.toList.foldl (fun acc b => acc + cond b 1 0) 0 -theorem Rq.get_zero (i : Fin ringDegree) : (0 : Rq).get i = 0 := +lemma Rq.get_zero (i : Fin ringDegree) : (0 : Rq).get i = 0 := NegacyclicRing.coeff_zero coeffRing i -@[simp] theorem Rq.get_add (a b : Rq) (i : Fin ringDegree) : +@[simp] lemma Rq.get_add (a b : Rq) (i : Fin ringDegree) : (a + b).get i = a.get i + b.get i := NegacyclicRing.coeff_add coeffRing a b i -@[simp] theorem Rq.get_neg (a : Rq) (i : Fin ringDegree) : +@[simp] lemma Rq.get_neg (a : Rq) (i : Fin ringDegree) : (-a).get i = -a.get i := NegacyclicRing.coeff_neg coeffRing a i -@[simp] theorem Rq.get_sub (a b : Rq) (i : Fin ringDegree) : +@[simp] lemma Rq.get_sub (a b : Rq) (i : Fin ringDegree) : (a - b).get i = a.get i - b.get i := NegacyclicRing.coeff_sub coeffRing a b i @@ -158,7 +158,7 @@ structure BalancedDecomp (alpha m : ℕ) : Prop where hqm1 : alpha * m = modulus - 1 hsmall : 2 * (alpha + 1) < modulus -theorem BalancedDecomp.ofApproved {p : Params} (hp : p.isApproved) : +lemma BalancedDecomp.ofApproved {p : Params} (hp : p.isApproved) : BalancedDecomp (2 * p.gamma2) ((modulus - 1) / (2 * p.gamma2)) where hα := by rcases hp with rfl | rfl | rfl <;> norm_num [mldsa44, mldsa65, mldsa87, ParameterSet.params, modulus] heven := by simp only [even_two, Even.mul_right] @@ -192,12 +192,12 @@ lemma hunit {ctx : BalancedDecomp alpha m} : IsUnit (alpha : Coeff) := end BalancedDecomp -theorem natCast_div_add_mod (r : Coeff) (s : ℕ) : +lemma natCast_div_add_mod (r : Coeff) (s : ℕ) : s * ((r.val / s):Coeff) + ((r.val % s): Coeff) = r := by simpa only [Nat.cast_add, Nat.cast_mul, ZMod.natCast_zmod_val] using congrArg (Nat.cast : ℕ → Coeff) (Nat.div_add_mod r.val s) -theorem power2RoundCoeff_eq (r : Coeff) {r1 : ℕ} {r0 : ℤ} +lemma power2RoundCoeff_eq (r : Coeff) {r1 : ℕ} {r0 : ℤ} (hdecomp : power2RoundCoeff r = (r1, r0)) : ((power2Scale : Coeff) * (r1 : Coeff)) + r0 = r := by simp only [power2RoundCoeff] at hdecomp @@ -206,7 +206,7 @@ theorem power2RoundCoeff_eq (r : Coeff) {r1 : ℕ} {r0 : ℤ} · exact hdam · ring_nf; exact hdam -theorem power2RoundCoeff_bound (r : Coeff) : +lemma power2RoundCoeff_bound (r : Coeff) : (power2RoundCoeff r).2.natAbs ≤ power2Scale / 2 := by simp only [power2RoundCoeff] split_ifs with h @@ -215,7 +215,7 @@ theorem power2RoundCoeff_bound (r : Coeff) : rw [Int.natAbs_natCast_sub_natCast_of_le htlt.le] omega -theorem decomposeCoeff_eq +lemma decomposeCoeff_eq {alpha r1 : ℕ} (r : Coeff) {r0 : ℤ} (h2α : 2 * (alpha / 2) = alpha) (hdecomp : decomposeCoeff r (alpha / 2) = (r1, r0)) : @@ -235,7 +235,7 @@ theorem decomposeCoeff_eq · rw [← hdam]; ring_nf; rw [← hwrap (q+1) hs]; push_cast; ring_nf · rw [← hdam]; ring -theorem lowBitsCoeff_bound (r : Coeff) {r1 gamma2 : ℕ} {r0 : ℤ} (hγ : 0 < gamma2) +lemma lowBitsCoeff_bound (r : Coeff) {r1 gamma2 : ℕ} {r0 : ℤ} (hγ : 0 < gamma2) (hdec : decomposeCoeff r gamma2 = (r1, r0)) : r0.natAbs ≤ gamma2 := by simp only [decomposeCoeff] at hdec @@ -247,7 +247,7 @@ theorem lowBitsCoeff_bound (r : Coeff) {r1 gamma2 : ℕ} {r0 : ℤ} (hγ : 0 < g obtain ⟨rfl, rfl⟩ := hdec all_goals omega -theorem centeredRepr_intCast_lowBitsCoeff (r : Coeff) {gamma2 : ℕ} +lemma centeredRepr_intCast_lowBitsCoeff (r : Coeff) {gamma2 : ℕ} (hγ : 0 < gamma2) (hq : 2 * gamma2 < modulus) : centeredRepr ((lowBitsCoeff r gamma2):Coeff) = lowBitsCoeff r gamma2 := by have : (lowBitsCoeff r gamma2).natAbs ≤ gamma2 := by @@ -257,26 +257,26 @@ theorem centeredRepr_intCast_lowBitsCoeff (r : Coeff) {gamma2 : ℕ} exact centeredRepr_intCast_eq_of_natAbs_le (b:=gamma2) (lowBitsCoeff r gamma2) this hq -theorem power2RoundShift_high_get (r : Rq) (i : Fin ringDegree) : +lemma power2RoundShift_high_get (r : Rq) (i : Fin ringDegree) : (power2RoundShift (power2RoundHigh r)).get i = (power2Scale : Coeff) * ((power2RoundCoeff (r.get i)).1 : Coeff) := by simp [power2RoundShift, power2RoundHigh] -theorem power2RoundLow_get (r : Rq) (i : Fin ringDegree) : +lemma power2RoundLow_get (r : Rq) (i : Fin ringDegree) : (power2RoundLow r).get i = (power2RoundCoeff (r.get i)).2 := by simp [power2RoundLow] -theorem concretePower2Round_high_low_decomp (r : Rq) : +lemma concretePower2Round_high_low_decomp (r : Rq) : power2RoundShift (power2RoundHigh r) + power2RoundLow r = r := Poly.ext_get_eq fun j => by rw [Rq.get_add, power2RoundShift_high_get, power2RoundLow_get] exact power2RoundCoeff_eq (r.get j) rfl -theorem concretePower2Round_remainder_eq_low (r : Rq) : +lemma concretePower2Round_remainder_eq_low (r : Rq) : r - power2RoundShift (power2RoundHigh r) = power2RoundLow r := sub_eq_iff_eq_add'.2 (concretePower2Round_high_low_decomp r).symm -theorem concretePower2Round_bound (r : Rq) : +lemma concretePower2Round_bound (r : Rq) : cInfNorm (r - power2RoundShift (power2RoundHigh r)) ≤ 2 ^ (droppedBits - 1) := by rw [concretePower2Round_remainder_eq_low] refine cInfNorm_le_of_coeff_le fun i => ?_ @@ -287,16 +287,16 @@ theorem concretePower2Round_bound (r : Rq) : (by norm_num [power2Scale, droppedBits, modulus])] exact power2RoundCoeff_bound (r.get i) -theorem highBitsShift_high_get (p : Params) (r : Rq) (i : Fin ringDegree) : +lemma highBitsShift_high_get (p : Params) (r : Rq) (i : Fin ringDegree) : (highBitsShift p (highBits p r)).get i = ((2 * p.gamma2 : ℕ) : Coeff) * (highBitsCoeff (r.get i) p.gamma2 : Coeff) := by simp [highBitsShift, highBits] -theorem lowBits_get (p : Params) (r : Rq) (i : Fin ringDegree) : +lemma lowBits_get (p : Params) (r : Rq) (i : Fin ringDegree) : (lowBits p r).get i = lowBitsCoeff (r.get i) p.gamma2 := by simp [lowBits] -theorem concreteRounding_high_low_decomp (p : Params) (r : Rq) : +lemma concreteRounding_high_low_decomp (p : Params) (r : Rq) : highBitsShift p (highBits p r) + lowBits p r = r := Poly.ext_get_eq fun j => by rw [Rq.get_add, highBitsShift_high_get, lowBits_get] @@ -304,7 +304,7 @@ theorem concreteRounding_high_low_decomp (p : Params) (r : Rq) : exact decomposeCoeff_eq (alpha := 2 * p.gamma2) (r.get j) (by omega) (by simp only [this]; exact Prod.eta _) -theorem concreteRounding_lowBits_bound (p : Params) +lemma concreteRounding_lowBits_bound (p : Params) (hγ : 0 < p.gamma2) (hq : 2 * p.gamma2 < modulus) (r : Rq) : cInfNorm (lowBits p r) ≤ p.gamma2 := by refine cInfNorm_le_of_coeff_le ?_ @@ -315,7 +315,7 @@ theorem concreteRounding_lowBits_bound (p : Params) rcases hdec : decomposeCoeff (r.get i) p.gamma2 with ⟨r1, r0⟩ exact lowBitsCoeff_bound (r := r.get i) hγ hdec -theorem highBitsCoeff_lt_m {alpha m : ℕ} +lemma highBitsCoeff_lt_m {alpha m : ℕ} (ctx : BalancedDecomp alpha m) (r : Coeff) : highBitsCoeff r (alpha / 2) < m := by simp only [highBitsCoeff, decomposeCoeff, ctx.h2α] @@ -340,13 +340,13 @@ theorem highBitsCoeff_lt_m {alpha m : ℕ} have hdiv_le := Nat.add_one_le_of_lt hlt exact lt_of_le_of_ne hdiv_le fun hm => hs (by rw [hm, ctx.hqm1]) -theorem alpha_mul_pred_m_eq {alpha m : ℕ} (ctx : BalancedDecomp alpha m) : +lemma alpha_mul_pred_m_eq {alpha m : ℕ} (ctx : BalancedDecomp alpha m) : (alpha: Coeff) * ((m - 1 : ℕ) : Coeff) = (-1 : Coeff) - (alpha : Coeff) := by rw [Nat.cast_sub (show 1 ≤ m from ctx.hm), mul_sub, ← Nat.cast_mul, ctx.hqm1, Nat.cast_sub (show 1 ≤ modulus by norm_num [modulus]), ZMod.natCast_self] ring_nf -theorem highBitsCoeff_eq_of_repr {alpha m : ℕ} (ctx : BalancedDecomp alpha m) +lemma highBitsCoeff_eq_of_repr {alpha m : ℕ} (ctx : BalancedDecomp alpha m) {r : Coeff} (r1 : ℕ) (r0 : ℤ) (hr1 : r1 < m) (hr0 : r0.natAbs ≤ alpha / 2) @@ -430,7 +430,7 @@ theorem highBitsCoeff_eq_of_repr {alpha m : ℕ} (ctx : BalancedDecomp alpha m) ring_nf · right; omega -theorem alpha_le_natAbs_centeredRepr_mul +lemma alpha_le_natAbs_centeredRepr_mul {alpha m : ℕ} (ctx : BalancedDecomp alpha m) {z : ℤ} (hz0 : 0 < z) (hzm : z.toNat < m) : alpha ≤ (centeredRepr ((alpha : Coeff) * (z : Coeff))).natAbs := by @@ -448,7 +448,7 @@ theorem alpha_le_natAbs_centeredRepr_mul ZMod.val_natCast_of_lt (by omega)] omega -theorem highBitsCoeff_add_eq_of_centeredRepr_lt +lemma highBitsCoeff_add_eq_of_centeredRepr_lt {alpha m b : ℕ} (ctx : BalancedDecomp alpha m) (r s : Coeff) (hs : (centeredRepr s).natAbs ≤ b) (hr : (lowBitsCoeff r (alpha / 2)).natAbs < (alpha / 2) - b) : @@ -491,7 +491,7 @@ theorem highBitsCoeff_add_eq_of_centeredRepr_lt · simpa [highBitsCoeff, hdecomp_r] using highBitsCoeff_lt_m ctx r · rw [show w - v = -(v - w) from by ring, Int.natAbs_neg]; exact hdiffbound -theorem useHintCoeff_shift_sub_le +lemma useHintCoeff_shift_sub_le {alpha m : ℕ} (ctx : BalancedDecomp alpha m) (hbit : Bool) (r : Coeff) : (centeredRepr (r - (alpha : Coeff) * (useHintCoeff hbit r (alpha / 2) : Coeff))).natAbs ≤ @@ -538,7 +538,7 @@ theorem useHintCoeff_shift_sub_le push_cast; ring · omega -theorem highBitsCoeff_eq_of_pos_overflow {alpha m : ℕ} (ctx : BalancedDecomp alpha m) +lemma highBitsCoeff_eq_of_pos_overflow {alpha m : ℕ} (ctx : BalancedDecomp alpha m) {s : Coeff} (r1 : ℕ) (v : ℤ) (hr1 : r1 < m) (hv_lo : (alpha / 2 : ℤ) < v) @@ -560,7 +560,7 @@ theorem highBitsCoeff_eq_of_pos_overflow {alpha m : ℕ} (ctx : BalancedDecomp a show r1 = m - 1 from by omega, alpha_mul_pred_m_eq ctx] push_cast; ring -theorem highBitsCoeff_eq_of_neg_overflow {alpha m : ℕ} (ctx : BalancedDecomp alpha m) +lemma highBitsCoeff_eq_of_neg_overflow {alpha m : ℕ} (ctx : BalancedDecomp alpha m) {s : Coeff} (r1 : ℕ) (v : ℤ) (hr1 : r1 < m) (hv_lo : -(alpha : ℤ) ≤ v) @@ -583,7 +583,7 @@ theorem highBitsCoeff_eq_of_neg_overflow {alpha m : ℕ} (ctx : BalancedDecomp a Nat.add_mod_right, Nat.mod_eq_of_lt (by omega)] · rw [Nat.cast_sub hr1pos, ← hsum]; push_cast; ring -theorem useHintCoeff_makeHintCoeff_eq_of_small +lemma useHintCoeff_makeHintCoeff_eq_of_small {alpha m : ℕ} (ctx : BalancedDecomp alpha m) (z r : Coeff) (hz : (centeredRepr z).natAbs ≤ alpha / 2) : useHintCoeff (makeHintCoeff z r (alpha / 2)) r (alpha / 2) = @@ -635,7 +635,7 @@ theorem useHintCoeff_makeHintCoeff_eq_of_small simp only [makeHintCoeff, ne_eq, hneq, not_false_eq_true, decide_true, huse] rw [highBitsCoeff_eq_of_neg_overflow ctx r1 v hr1lt (by omega) hv_hi hsum] -theorem highBitsShift_injective_of_isApproved (p : Params) +lemma highBitsShift_injective_of_isApproved (p : Params) (hp : p.isApproved) : Function.Injective (highBitsShift p) := by intro x y hxy @@ -647,7 +647,7 @@ theorem highBitsShift_injective_of_isApproved (p : Params) /-- For approved parameters, each `HighBits` coefficient lies in the valid commitment window `[0, (q - 1) / (2 γ₂) - 1]`: its `ZMod` value is strictly below `(q - 1) / (2 γ₂)`. This is the range produced by Algorithm 37 and the domain on which the `w₁` packer is injective. -/ -theorem highBits_coeff_val_lt_m (p : Params) (hp : p.isApproved) (r : Rq) (i : Fin ringDegree) : +lemma highBits_coeff_val_lt_m (p : Params) (hp : p.isApproved) (r : Rq) (i : Fin ringDegree) : ((highBits p r).get i).val < (modulus - 1) / (2 * p.gamma2) := by have hcoeff : highBitsCoeff (r.get i) p.gamma2 < (modulus - 1) / (2 * p.gamma2) := by have ctx := BalancedDecomp.ofApproved hp @@ -677,7 +677,7 @@ def concreteRoundingOps (p : Params) : MLDSA.RoundingOps (2 * p.gamma2) where makeHint := makeHint p useHint := useHint p -theorem concreteRounding_useHint_correct_of_isApproved (p : Params) +lemma concreteRounding_useHint_correct_of_isApproved (p : Params) (hp : p.isApproved) (z r : Rq) : cInfNorm z ≤ p.gamma2 → useHint p (makeHint p z r) r = highBits p (r + z) := by @@ -688,7 +688,7 @@ theorem concreteRounding_useHint_correct_of_isApproved (p : Params) simpa using useHintCoeff_makeHintCoeff_eq_of_small (BalancedDecomp.ofApproved hp) (z := z.get j) (r := r.get j) (by simpa using cInfNorm_le_iff.mp hz j) -theorem concreteRounding_useHint_bound_of_isApproved (p : Params) +lemma concreteRounding_useHint_bound_of_isApproved (p : Params) (hp : p.isApproved) (r : Rq) (h : Hint) : cInfNorm (r - highBitsShift p (useHint p h r)) ≤ 2 * p.gamma2 + 1 := by refine cInfNorm_le_iff.mpr fun j => ?_ @@ -698,7 +698,7 @@ theorem concreteRounding_useHint_bound_of_isApproved (p : Params) simpa using useHintCoeff_shift_sub_le (BalancedDecomp.ofApproved hp) (h.get j) (r.get j) -theorem concreteRounding_hide_low_of_isApproved (p : Params) +lemma concreteRounding_hide_low_of_isApproved (p : Params) (hp : p.isApproved) (r s : Rq) (b : ℕ) : cInfNorm s ≤ b → cInfNorm (lowBits p r) + b < p.gamma2 → @@ -721,11 +721,11 @@ theorem concreteRounding_hide_low_of_isApproved (p : Params) exact highBitsCoeff_add_eq_of_centeredRepr_lt ctx (r.get j) (s.get j) (cInfNorm_le_iff.mp hs j) hr -theorem concretePower2RoundLaws : +lemma concretePower2RoundLaws : Power2RoundOps.Laws (ring := coeffRing) concretePower2RoundOps cInfNorm where power2Round_bound := concretePower2Round_bound -theorem concreteRoundingLaws_of_isApproved (p : Params) (hp : p.isApproved) : +lemma concreteRoundingLaws_of_isApproved (p : Params) (hp : p.isApproved) : RoundingOps.Laws (ring := coeffRing) (concreteRoundingOps p) cInfNorm where high_low_decomp := concreteRounding_high_low_decomp p lowBits_bound r := by diff --git a/src/Commons/Schemes/Signature/MLDSA/Concrete/Sampling.lean b/src/Commons/Schemes/Signature/MLDSA/Concrete/Sampling.lean index 8013bb7..6426f3d 100644 --- a/src/Commons/Schemes/Signature/MLDSA/Concrete/Sampling.lean +++ b/src/Commons/Schemes/Signature/MLDSA/Concrete/Sampling.lean @@ -166,7 +166,7 @@ def expandMask (rhoPrime : Bytes 64) (kappa : ℕ) (p : Params) : RqVec p.l := /-- Every component produced by `expandMask` lies in the FIPS-204 `z` window for an approved parameter set. -/ -theorem expandMask_get_cInfNorm_le (p : Params) (hp : p.isApproved) (rhoPrime : Bytes 64) +lemma expandMask_get_cInfNorm_le (p : Params) (hp : p.isApproved) (rhoPrime : Bytes 64) (kappa : ℕ) (j : Fin p.l) : LatticeCrypto.cInfNorm ((expandMask rhoPrime kappa p).get j) ≤ p.gamma1 := by obtain ⟨hwidth, hq⟩ := approved_gamma1_width p hp @@ -242,7 +242,7 @@ consumed by the `concrete_*` theorems of `Commons.Schemes.Signature.MLDSA.Concre open LatticeCrypto in /-- After a `set!`, the defaulted lookup at any index is either the freshly written value or the prior defaulted lookup. -/ -theorem getD_set!_or {α : Type*} (a : Array α) (i : ℕ) (v d : α) (j : ℕ) : +lemma getD_set!_or {α : Type*} (a : Array α) (i : ℕ) (v d : α) (j : ℕ) : (a.set! i v).getD j d = v ∨ (a.set! i v).getD j d = a.getD j d := by simp only [Array.set!, Array.getD_eq_getD_getElem?, Array.getElem?_setIfInBounds] by_cases heq : i = j <;> by_cases hj : j < a.size <;> simp [heq, hj] @@ -250,7 +250,7 @@ theorem getD_set!_or {α : Type*} (a : Array α) (i : ℕ) (v d : α) (j : ℕ) /-- One `sampleInBallStep` only writes a previously stored value (`out.getD chosen 0`) and a sign `±1`, so if every defaulted entry of `out` lies in `{0, 1, -1}` then so does every defaulted entry of the updated accumulator. -/ -theorem sampleInBallStep_mem (stream : ByteArray) (signs i : ℕ) (out : Array Coeff) +lemma sampleInBallStep_mem (stream : ByteArray) (signs i : ℕ) (out : Array Coeff) (pos signIdx : ℕ) (hInv : ∀ j, (out.getD j 0 = 0 ∨ out.getD j 0 = 1 ∨ out.getD j 0 = -1)) (j : ℕ) : (sampleInBallStep stream signs i out pos signIdx).1.getD j 0 = 0 ∨ @@ -273,7 +273,7 @@ theorem sampleInBallStep_mem (stream : ByteArray) (signs i : ℕ) (out : Array C /-- The `sampleInBall` accumulator only ever holds values in `{0, 1, -1}` (every defaulted entry), by fuel induction on the outer challenge loop, starting from the all-zero accumulator. -/ -theorem sampleInBallLoop_mem (stream : ByteArray) (signs hi : ℕ) : +lemma sampleInBallLoop_mem (stream : ByteArray) (signs hi : ℕ) : ∀ (fuel i : ℕ) (out : Array Coeff) (pos signIdx : ℕ), (∀ j, (out.getD j 0 = 0 ∨ out.getD j 0 = 1 ∨ out.getD j 0 = -1)) → ∀ j, (sampleInBallLoop stream signs hi fuel i out pos signIdx).getD j 0 = 0 ∨ @@ -290,7 +290,7 @@ theorem sampleInBallLoop_mem (stream : ByteArray) (signs hi : ℕ) : exact hInv j /-- Every coefficient of `sampleInBall` lies in `{0, 1, -1}`. -/ -theorem sampleInBall_coeff_mem (p : Params) (seed : CommitHashBytes p) (i : Fin ringDegree) : +lemma sampleInBall_coeff_mem (p : Params) (seed : CommitHashBytes p) (i : Fin ringDegree) : (sampleInBall p seed).get i = 0 ∨ (sampleInBall p seed).get i = 1 ∨ (sampleInBall p seed).get i = -1 := by unfold sampleInBall @@ -302,7 +302,7 @@ theorem sampleInBall_coeff_mem (p : Params) (seed : CommitHashBytes p) (i : Fin by_cases hj : j < ringDegree <;> simp [hj] /-- `sampleInBall` has centered infinity norm at most `1` (coefficients in `{-1, 0, +1}`). -/ -theorem sampleInBall_norm (p : Params) (seed : CommitHashBytes p) : +lemma sampleInBall_norm (p : Params) (seed : CommitHashBytes p) : polyNorm (sampleInBall p seed) ≤ 1 := by rw [polyNorm_eq_cInfNorm, LatticeCrypto.cInfNorm_le_iff] intro i @@ -322,19 +322,19 @@ def countNZ (out : Array Coeff) : ℕ := ∑ j ∈ Finset.range ringDegree, (LatticeCrypto.centeredRepr (out.getD j 0)).natAbs /-- A defaulted lookup at the just-written slot returns the written value. -/ -theorem getD_set!_self (out : Array Coeff) (a : ℕ) (ha : a < out.size) (u : Coeff) : +lemma getD_set!_self (out : Array Coeff) (a : ℕ) (ha : a < out.size) (u : Coeff) : (out.set! a u).getD a 0 = u := by simp only [Array.set!, Array.getD_eq_getD_getElem?, Array.getElem?_setIfInBounds, ha, ite_true, Option.getD_some] /-- A defaulted lookup away from the just-written slot is unchanged. -/ -theorem getD_set!_ne (out : Array Coeff) (a : ℕ) (u : Coeff) (j : ℕ) (hj : j ≠ a) : +lemma getD_set!_ne (out : Array Coeff) (a : ℕ) (u : Coeff) (j : ℕ) (hj : j ≠ a) : (out.set! a u).getD j 0 = out.getD j 0 := by simp only [Array.set!, Array.getD_eq_getD_getElem?, Array.getElem?_setIfInBounds] rw [if_neg (fun h => hj h.symm)] /-- Exact additive single-slot update law for `countNZ`, stated to avoid `ℕ` subtraction. -/ -theorem countNZ_set!_eq (out : Array Coeff) (a : ℕ) (ha : a < ringDegree) +lemma countNZ_set!_eq (out : Array Coeff) (a : ℕ) (ha : a < ringDegree) (hsize : out.size = ringDegree) (u : Coeff) : countNZ (out.set! a u) + (LatticeCrypto.centeredRepr (out.getD a 0)).natAbs = countNZ out + (LatticeCrypto.centeredRepr u).natAbs := by @@ -352,7 +352,7 @@ theorem countNZ_set!_eq (out : Array Coeff) (a : ℕ) (ha : a < ringDegree) rw [hrest]; ring /-- The chosen slot index returned by the find loop is always `≤ i`. -/ -theorem findChosen_le (stream : ByteArray) (i : ℕ) : +lemma findChosen_le (stream : ByteArray) (i : ℕ) : ∀ (fuel pos : ℕ), (sampleInBallFindChosen stream i fuel pos).1 ≤ i := by intro fuel induction fuel with @@ -364,13 +364,13 @@ theorem findChosen_le (stream : ByteArray) (i : ℕ) : · simp only [hb, ite_false]; exact ih (pos + 1) /-- One challenge step preserves the accumulator size. -/ -theorem step_size (stream : ByteArray) (signs i : ℕ) (out : Array Coeff) (pos signIdx : ℕ) +lemma step_size (stream : ByteArray) (signs i : ℕ) (out : Array Coeff) (pos signIdx : ℕ) (hsize : out.size = ringDegree) : (sampleInBallStep stream signs i out pos signIdx).1.size = ringDegree := by unfold sampleInBallStep; simp [Array.set!, hsize] /-- One challenge step preserves the freshness invariant: slots strictly above `i` stay zero. -/ -theorem step_fresh (stream : ByteArray) (signs i : ℕ) (out : Array Coeff) (pos signIdx : ℕ) +lemma step_fresh (stream : ByteArray) (signs i : ℕ) (out : Array Coeff) (pos signIdx : ℕ) (hfresh : ∀ j, i ≤ j → out.getD j 0 = 0) : ∀ j, i + 1 ≤ j → (sampleInBallStep stream signs i out pos signIdx).1.getD j 0 = 0 := by intro j hj @@ -382,7 +382,7 @@ theorem step_fresh (stream : ByteArray) (signs i : ℕ) (out : Array Coeff) (pos /-- One challenge step increases the nonzero count by at most one (in fact exactly one), given the freshness of slot `i`. -/ -theorem step_countNZ_le (stream : ByteArray) (signs i : ℕ) (out : Array Coeff) +lemma step_countNZ_le (stream : ByteArray) (signs i : ℕ) (out : Array Coeff) (pos signIdx : ℕ) (hi : i < ringDegree) (hsize : out.size = ringDegree) (hfresh : (LatticeCrypto.centeredRepr (out.getD i 0)).natAbs = 0) : countNZ (sampleInBallStep stream signs i out pos signIdx).1 ≤ countNZ out + 1 := by @@ -413,7 +413,7 @@ theorem step_countNZ_le (stream : ByteArray) (signs i : ℕ) (out : Array Coeff) rw [hgc] at e2; rw [e1, hsignAbs] at e2; omega /-- The challenge loop increases the nonzero count by at most the number of indices it processes. -/ -theorem loop_countNZ_le (stream : ByteArray) (signs hi : ℕ) (hhi : hi ≤ ringDegree) : +lemma loop_countNZ_le (stream : ByteArray) (signs hi : ℕ) (hhi : hi ≤ ringDegree) : ∀ (fuel i : ℕ) (out : Array Coeff) (pos signIdx : ℕ), out.size = ringDegree → (∀ j, i ≤ j → out.getD j 0 = 0) → countNZ (sampleInBallLoop stream signs hi fuel i out pos signIdx) ≤ countNZ out + (hi - i) @@ -442,7 +442,7 @@ theorem loop_countNZ_le (stream : ByteArray) (signs hi : ℕ) (hhi : hi ≤ ring exact Nat.le_add_right _ _ /-- The all-zero accumulator has nonzero count zero. -/ -theorem countNZ_replicate_zero : countNZ (Array.replicate ringDegree (0 : Coeff)) = 0 := by +lemma countNZ_replicate_zero : countNZ (Array.replicate ringDegree (0 : Coeff)) = 0 := by unfold countNZ apply Finset.sum_eq_zero intro j _ @@ -452,7 +452,7 @@ theorem countNZ_replicate_zero : countNZ (Array.replicate ringDegree (0 : Coeff) /-- The `ℓ₁` norm of a polynomial materialized by `Vector.ofFn` from a defaulted-array lookup is the nonzero count of that array. -/ -theorem l1Norm_ofPi_eq_countNZ (coeffs : Array Coeff) : +lemma l1Norm_ofPi_eq_countNZ (coeffs : Array Coeff) : LatticeCrypto.l1Norm (LatticeCrypto.Poly.ofPi (fun i : Fin ringDegree => coeffs.getD i.val 0)) = countNZ coeffs := by @@ -465,7 +465,7 @@ theorem l1Norm_ofPi_eq_countNZ (coeffs : Array Coeff) : /-- The challenge loop, run from the all-zero accumulator over `[ringDegree - τ, ringDegree)`, produces an array with nonzero count at most `τ`. -/ -theorem countNZ_sampleInBallLoop_le (stream : ByteArray) (signs : ℕ) (p : Params) : +lemma countNZ_sampleInBallLoop_le (stream : ByteArray) (signs : ℕ) (p : Params) : countNZ (sampleInBallLoop stream signs ringDegree p.tau (ringDegree - p.tau) (Array.replicate ringDegree 0) 8 0) ≤ p.tau := by have hsize : (Array.replicate ringDegree (0 : Coeff)).size = ringDegree := @@ -482,7 +482,7 @@ theorem countNZ_sampleInBallLoop_le (stream : ByteArray) (signs : ℕ) (p : Para /-- `sampleInBall` has centered `ℓ₁` norm at most `τ` (it writes at most `τ` nonzero `±1` coefficients). This is the count needed for the challenge-product bound `‖c · s‖∞ ≤ τ · η`. -/ -theorem sampleInBall_l1Norm (p : Params) (seed : CommitHashBytes p) : +lemma sampleInBall_l1Norm (p : Params) (seed : CommitHashBytes p) : LatticeCrypto.l1Norm (sampleInBall p seed) ≤ p.tau := by unfold sampleInBall rw [l1Norm_ofPi_eq_countNZ] @@ -490,7 +490,7 @@ theorem sampleInBall_l1Norm (p : Params) (seed : CommitHashBytes p) : /-- After a `push`, the defaulted lookup at any index is either the pushed value or the prior defaulted lookup. -/ -theorem getD_push_or {α : Type*} (a : Array α) (v d : α) (j : ℕ) : +lemma getD_push_or {α : Type*} (a : Array α) (v d : α) (j : ℕ) : (a.push v).getD j d = v ∨ (a.push v).getD j d = a.getD j d := by simp only [Array.getD_eq_getD_getElem?, Array.getElem?_push] by_cases h : j < a.size <;> by_cases h2 : j = a.size <;> simp [h, h2] @@ -504,7 +504,7 @@ def EtaInv (eta : ℕ) (c : Array ℤ) : Prop := /-- A conditional push of a value whose `Coeff` cast is centered-bounded by `eta` (whenever the guard holds) preserves `EtaInv`. -/ -theorem EtaInv_condPush (eta : ℕ) (c : Array ℤ) (v : ℤ) (cond : Prop) [Decidable cond] +lemma EtaInv_condPush (eta : ℕ) (c : Array ℤ) (v : ℤ) (cond : Prop) [Decidable cond] (hc : EtaInv eta c) (hv : cond → (LatticeCrypto.centeredRepr ((v : Coeff))).natAbs ≤ eta) : EtaInv eta (if cond then c.push v else c) := by @@ -519,7 +519,7 @@ theorem EtaInv_condPush (eta : ℕ) (c : Array ℤ) (v : ℤ) (cond : Prop) [Dec /-- One `rejEtaStep` only pushes values whose `Coeff` cast is centered-bounded by `eta` (in the `eta = 2` and `eta = 4` branches; in any other case it pushes nothing). So `EtaInv eta` is preserved by a step. -/ -theorem rejEtaStep_mem (eta byte : ℕ) (coeffs : Array ℤ) +lemma rejEtaStep_mem (eta byte : ℕ) (coeffs : Array ℤ) (hInv : EtaInv eta coeffs) : EtaInv eta (rejEtaStep eta byte coeffs) := by unfold rejEtaStep have hb2 : ∀ (tt : ℕ), tt < 15 → @@ -548,7 +548,7 @@ theorem rejEtaStep_mem (eta byte : ℕ) (coeffs : Array ℤ) · exact hInv /-- `EtaInv eta` is preserved through the whole `rejEtaCoeffsAux` fuel recursion. -/ -theorem rejEtaCoeffsAux_mem (eta : ℕ) (stream : ByteArray) : +lemma rejEtaCoeffsAux_mem (eta : ℕ) (stream : ByteArray) : ∀ (fuel : ℕ) (coeffs : Array ℤ) (pos : ℕ), EtaInv eta coeffs → EtaInv eta (rejEtaCoeffsAux eta stream fuel coeffs pos) | 0, coeffs, _, hInv => by simpa [rejEtaCoeffsAux] using hInv @@ -561,12 +561,12 @@ theorem rejEtaCoeffsAux_mem (eta : ℕ) (stream : ByteArray) : exact hInv /-- The centered representative of the `Coeff` cast of `0` has absolute value `0`. -/ -theorem centeredRepr_zero_cast_le (eta : ℕ) : +lemma centeredRepr_zero_cast_le (eta : ℕ) : (LatticeCrypto.centeredRepr (((0 : ℤ) : Coeff))).natAbs ≤ eta := by have : LatticeCrypto.centeredRepr (((0 : ℤ) : Coeff)) = 0 := by rfl rw [this]; exact Nat.zero_le eta -theorem EtaInv_mkEmpty (eta : ℕ) : EtaInv eta (Array.mkEmpty ringDegree) := by +lemma EtaInv_mkEmpty (eta : ℕ) : EtaInv eta (Array.mkEmpty ringDegree) := by intro j have hz : (Array.mkEmpty ringDegree : Array ℤ).getD j 0 = 0 := by rw [Array.getD_eq_getD_getElem?]; simp @@ -575,7 +575,7 @@ theorem EtaInv_mkEmpty (eta : ℕ) : EtaInv eta (Array.mkEmpty ringDegree) := by /-- The `requireFullEtaSample` guard preserves `EtaInv`: it returns either the input array or the empty fallback, both `EtaInv`. -/ -theorem requireFullEtaSample_mem (eta : ℕ) (coeffs : Array ℤ) (hInv : EtaInv eta coeffs) : +lemma requireFullEtaSample_mem (eta : ℕ) (coeffs : Array ℤ) (hInv : EtaInv eta coeffs) : EtaInv eta (requireFullEtaSample coeffs) := by unfold requireFullEtaSample split @@ -588,7 +588,7 @@ theorem requireFullEtaSample_mem (eta : ℕ) (coeffs : Array ℤ) (hInv : EtaInv exact centeredRepr_zero_cast_le eta /-- Every coefficient of `sampleEtaPoly eta seed nonce` has centered infinity norm at most `eta`. -/ -theorem sampleEtaPoly_norm (eta : ℕ) (seed : Bytes 64) (nonce : ℕ) : +lemma sampleEtaPoly_norm (eta : ℕ) (seed : Bytes 64) (nonce : ℕ) : polyNorm (sampleEtaPoly eta seed nonce) ≤ eta := by rw [polyNorm_eq_cInfNorm, LatticeCrypto.cInfNorm_le_iff] intro i @@ -597,7 +597,7 @@ theorem sampleEtaPoly_norm (eta : ℕ) (seed : Bytes 64) (nonce : ℕ) : exact requireFullEtaSample_mem eta _ (rejEtaCoeffsAux_mem eta _ _ _ _ (EtaInv_mkEmpty eta)) i.val /-- `expandS` produces secret vectors with every coefficient bounded by `η`. -/ -theorem expandS_bound (rhoPrime : Bytes 64) (p : Params) : +lemma expandS_bound (rhoPrime : Bytes 64) (p : Params) : polyVecBounded (expandS rhoPrime p).1 p.eta ∧ polyVecBounded (expandS rhoPrime p).2 p.eta := by constructor <;> diff --git a/src/Commons/Schemes/Signature/MLDSA/Scheme.lean b/src/Commons/Schemes/Signature/MLDSA/Scheme.lean index 66cfe45..d767131 100644 --- a/src/Commons/Schemes/Signature/MLDSA/Scheme.lean +++ b/src/Commons/Schemes/Signature/MLDSA/Scheme.lean @@ -102,7 +102,7 @@ seed space `Bytes 32` is finite. -/ noncomputable def validKeyPair (pk : PublicKey p prims) (sk : SecretKey p) : Bool := decide (∃ seed : Bytes 32, keyGenFromSeed p prims seed = (pk, sk)) -@[simp] theorem validKeyPair_eq_true_iff (pk : PublicKey p prims) (sk : SecretKey p) : +@[simp] lemma validKeyPair_eq_true_iff (pk : PublicKey p prims) (sk : SecretKey p) : validKeyPair p prims pk sk = true ↔ ∃ seed : Bytes 32, keyGenFromSeed p prims seed = (pk, sk) := by simp [validKeyPair] @@ -110,7 +110,7 @@ noncomputable def validKeyPair (pk : PublicKey p prims) (sk : SecretKey p) : Boo /-! ### Key Generation Algebraic Properties -/ /-- Keys generated by `keyGenFromSeed` satisfy `validKeyPair`. -/ -theorem keyGenFromSeed_validKeyPair (seed : Bytes 32) : +lemma keyGenFromSeed_validKeyPair (seed : Bytes 32) : let (pk, sk) := keyGenFromSeed p prims seed validKeyPair p prims pk sk = true := by simp only [validKeyPair_eq_true_iff] @@ -122,7 +122,7 @@ when `z = y + c·s₁` and the key pair comes from `keyGenFromSeed`. This is the core identity underlying both signing correctness and the security proof. It follows from `t = A·s₁ + s₂` (key generation), `t₁·2^d + t₀ = t` (Power2Round), and NTT linearity. -/ -theorem keyGenFromSeed_wApprox_eq {pk : PublicKey p prims} {sk : SecretKey p} +lemma keyGenFromSeed_wApprox_eq {pk : PublicKey p prims} {sk : SecretKey p} (h_laws : Primitives.Laws prims nttOps) (seed : Bytes 32) (hkeygen : keyGenFromSeed p prims seed = (pk, sk)) : diff --git a/src/Commons/Schemes/Signature/MLDSA/Signature.lean b/src/Commons/Schemes/Signature/MLDSA/Signature.lean index eb7cb35..d9a6688 100644 --- a/src/Commons/Schemes/Signature/MLDSA/Signature.lean +++ b/src/Commons/Schemes/Signature/MLDSA/Signature.lean @@ -314,7 +314,7 @@ and the challenge-product norm bound (`h_cs2_bound`, for the challenge `c = Samp These conditions follow from the key generation relationship `t = A·s₁ + s₂`, `(t₁,t₀) = Power2Round(t)`, and the weight/norm structure of challenge polynomials and secret keys. -/ -theorem fipsSign_fipsVerify_correct' +lemma fipsSign_fipsVerify_correct' (pk : PublicKey p prims) (sk : SecretKey p) (msg : List Byte) (sig : FIPSSignature p prims) (rhoDoublePrime : Bytes 64) (maxAttempts : ℕ) diff --git a/src/Commons/Schemes/Stream/CTR.lean b/src/Commons/Schemes/Stream/CTR.lean index 4142c50..0ac526b 100644 --- a/src/Commons/Schemes/Stream/CTR.lean +++ b/src/Commons/Schemes/Stream/CTR.lean @@ -59,11 +59,11 @@ block `T₁`: `Cⱼ = Pⱼ ⊕ E(Tⱼ)`, the last block truncated. Decryption is def crypt (E : Bytes 16 → Bytes 16) (T₁ : Bytes 16) (message : List UInt8) : List UInt8 := xorStream message ((counterBlocks T₁ (blockCount message.length)).map E) -theorem length_xorStream (message : List UInt8) (outputs : List (Bytes 16)) : +lemma length_xorStream (message : List UInt8) (outputs : List (Bytes 16)) : (xorStream message outputs).length ≤ message.length := by simp [xorStream] -theorem xorStream_xorStream (message : List UInt8) (outputs : List (Bytes 16)) +lemma xorStream_xorStream (message : List UInt8) (outputs : List (Bytes 16)) (h : message.length ≤ (outputs.flatMap Vector.toList).length) : xorStream (xorStream message outputs) outputs = message := by unfold xorStream @@ -78,19 +78,19 @@ theorem xorStream_xorStream (message : List UInt8) (outputs : List (Bytes 16)) exact ⟨by rw [UInt8.xor_assoc, UInt8.xor_self, UInt8.xor_zero], ih pad (by simpa using h)⟩ -theorem length_xorStream_eq (message : List UInt8) (outputs : List (Bytes 16)) +lemma length_xorStream_eq (message : List UInt8) (outputs : List (Bytes 16)) (h : message.length ≤ (outputs.flatMap Vector.toList).length) : (xorStream message outputs).length = message.length := by simp only [xorStream, List.length_zipWith] exact Nat.min_eq_left h -theorem length_flatMap_toList (outputs : List (Bytes 16)) : +lemma length_flatMap_toList (outputs : List (Bytes 16)) : (outputs.flatMap Vector.toList).length = 16 * outputs.length := by induction outputs with | nil => simp | cons b outputs ih => simp only [List.flatMap_cons, List.length_append, ih]; simp; ring -theorem length_outputs (E : Bytes 16 → Bytes 16) (T₁ : Bytes 16) (length : ℕ) : +lemma length_outputs (E : Bytes 16 → Bytes 16) (T₁ : Bytes 16) (length : ℕ) : length ≤ (((counterBlocks T₁ (blockCount length)).map E).flatMap Vector.toList).length := by rw [length_flatMap_toList, List.length_map, counterBlocks, List.length_iterate, blockCount] omega diff --git a/src/ConstructiveCryptography/Automaton.lean b/src/ConstructiveCryptography/Automaton.lean index b477e6e..de9f5f3 100644 --- a/src/ConstructiveCryptography/Automaton.lean +++ b/src/ConstructiveCryptography/Automaton.lean @@ -44,7 +44,7 @@ noncomputable def Resource.ofAutomaton (initial : Distribution.ProbDist S) : Res Distribution.fTransform_isProbDist _ initial.2⟩ /-- A transcript has the mass of the initial states from which the automaton gives it. -/ -theorem Resource.ofAutomaton_mass (initial : Distribution.ProbDist S) +lemma Resource.ofAutomaton_mass (initial : Distribution.ProbDist S) (h : List ((Σ i, T.X i) × (Σ i, T.Y i))) : (Resource.ofAutomaton T step initial).1 h = initial.1.mass fun s => Replies (filterDom T.domain (automatonSystem step s)) (h.map Prod.fst) (h.map Prod.snd) := by @@ -54,7 +54,7 @@ theorem Resource.ofAutomaton_mass (initial : Distribution.ProbDist S) /-- **Parallel automata** are the automaton running both side by side from independent initial states. -/ -theorem parallel_ofAutomaton {A B : Interface} {S T : Type} +lemma parallel_ofAutomaton {A B : Interface} {S T : Type} (f : S → (i : A.I) → A.X i → S × A.Y i) (g : T → (j : B.I) → B.X j → T × B.Y j) (P : Distribution.ProbDist S) (Q : Distribution.ProbDist T) : parallel (Resource.ofAutomaton A f P) (Resource.ofAutomaton B g Q) = diff --git a/src/ConstructiveCryptography/Construction/Basic.lean b/src/ConstructiveCryptography/Construction/Basic.lean index 9c9d094..4985335 100644 --- a/src/ConstructiveCryptography/Construction/Basic.lean +++ b/src/ConstructiveCryptography/Construction/Basic.lean @@ -21,7 +21,7 @@ variable {judgment : Constructor → Source → Target → Prop} constructor. MR16, Section 2.3 (printed p. 5): “R —γ→ S =⇒ R′ —γ→ S′ if R′ ⊆ R and S ⊆ S′.” For arbitrary judgments the implication is supplied explicitly. -/ -theorem Constructible.of_imp {Source' : Type v'} {Target' : Type w'} +lemma Constructible.of_imp {Source' : Type v'} {Target' : Type w'} {judgment' : Constructor → Source' → Target' → Prop} {constructors : Set Constructor} {source : Source} {target : Target} {source' : Source'} {target' : Target'} @@ -34,7 +34,7 @@ theorem Constructible.of_imp {Source' : Type v'} {Target' : Type w'} exact ⟨constructor, admitted, implication constructor admitted constructs⟩ /-- Enlarging the admitted constructor class preserves constructibility. -/ -theorem Constructible.mono_constructors {constructors constructors' : Set Constructor} +lemma Constructible.mono_constructors {constructors constructors' : Set Constructor} (included : constructors ⊆ constructors') {source : Source} {target : Target} (construction : Constructible judgment constructors source target) : Constructible judgment constructors' source target := by @@ -46,7 +46,7 @@ theorem Constructible.mono_constructors {constructors constructors' : Set Constr MR16, Section 2.3 (printed p. 6): “R ↛ S =⇒ R′ ↛ S′ if R ⊆ R′ and S′ ⊆ S.” -/ -theorem Unconstructible.of_imp {Source' : Type v'} {Target' : Type w'} +lemma Unconstructible.of_imp {Source' : Type v'} {Target' : Type w'} {judgment' : Constructor → Source' → Target' → Prop} {constructors : Set Constructor} {source : Source} {target : Target} {source' : Source'} {target' : Target'} @@ -58,7 +58,7 @@ theorem Unconstructible.of_imp {Source' : Type v'} {Target' : Type w'} /-- Non-constructibility against a class implies non-constructibility against each smaller class. -/ -theorem Unconstructible.mono_constructors {constructors constructors' : Set Constructor} +lemma Unconstructible.mono_constructors {constructors constructors' : Set Constructor} (included : constructors ⊆ constructors') {source : Source} {target : Target} (impossible : Unconstructible judgment constructors' source target) : Unconstructible judgment constructors source target := diff --git a/src/ConstructiveCryptography/Context.lean b/src/ConstructiveCryptography/Context.lean index 9a39c45..43e259f 100644 --- a/src/ConstructiveCryptography/Context.lean +++ b/src/ConstructiveCryptography/Context.lean @@ -41,14 +41,14 @@ noncomputable def resourceConverter (R : Interface.Resource A) : A ⟶ Interface PDCBehavior.ofPDC (resourcePDC R.exists_ofPDS.choose) /-- The unit interface has exactly one resource. -/ -theorem resource_empty_eq (S : Interface.Resource Interface.unit) : S = Interface.dummy := by +lemma resource_empty_eq (S : Interface.Resource Interface.unit) : S = Interface.dummy := by apply Subtype.ext apply RandomSystem.ext rintro (_ | ⟨⟨⟨e, _⟩, _⟩, _⟩) · rw [S.1.mass_nil, Interface.dummy.1.mass_nil] · exact e.elim -theorem attach_resourceConverter (R : Interface.Resource A) +lemma attach_resourceConverter (R : Interface.Resource A) (S : Interface.Resource Interface.unit) : (resourceConverter R • S : Interface.Resource A) = R := by rw [resource_empty_eq S] @@ -78,11 +78,11 @@ efficiency claim is made for this unrestricted mathematical converter. -/ noncomputable def constant (R : Interface.Resource A) (B : Interface) : A ⟶ B := resourceConverter R ≫ discardConverter B -theorem attach_constant (R : Interface.Resource A) {B : Interface} (S : Interface.Resource B) : +lemma attach_constant (R : Interface.Resource A) {B : Interface} (S : Interface.Resource B) : (constant R B • S : Interface.Resource A) = R := by rw [constant, Interface.comp_smul, attach_resourceConverter] -theorem rightUnitor_hom_attach (R : Interface.Resource A) : +lemma rightUnitor_hom_attach (R : Interface.Resource A) : ((Interface.rightUnitor A).hom • R : Interface.Resource (Interface.tensor A Interface.unit)) = Interface.parallel R Interface.dummy := by have h := congrArg (fun S : Interface.Resource A => ((Interface.rightUnitor A).hom • S : @@ -90,7 +90,7 @@ theorem rightUnitor_hom_attach (R : Interface.Resource A) : rw [← Interface.comp_smul, Iso.hom_inv_id, Interface.identity_attach] at h exact h.symm -theorem leftUnitor_hom_attach (R : Interface.Resource A) : +lemma leftUnitor_hom_attach (R : Interface.Resource A) : ((Interface.leftUnitor A).hom • R : Interface.Resource (Interface.tensor Interface.unit A)) = Interface.parallel Interface.dummy R := by have h := congrArg (fun S : Interface.Resource A => ((Interface.leftUnitor A).hom • S : @@ -108,12 +108,12 @@ noncomputable def leftContext {A : Interface} (R : Interface.Resource A) (B : In A ⊗ B ⟶ B := (resourceConverter R ⊗ₘ 𝟙 B) ≫ (Interface.leftUnitor B).hom -theorem attach_rightContext (R : Interface.Resource A) (S : Interface.Resource B) : +lemma attach_rightContext (R : Interface.Resource A) (S : Interface.Resource B) : (rightContext A S • R : Interface.Resource (A ⊗ B)) = Interface.parallel R S := by rw [rightContext, Interface.comp_smul, rightUnitor_hom_attach, Interface.tensorHom_eq, Interface.parallel_attach, Interface.identity_attach, attach_resourceConverter] -theorem attach_leftContext (R : Interface.Resource A) (S : Interface.Resource B) : +lemma attach_leftContext (R : Interface.Resource A) (S : Interface.Resource B) : (leftContext R B • S : Interface.Resource (A ⊗ B)) = Interface.parallel R S := by rw [leftContext, Interface.comp_smul, leftUnitor_hom_attach, Interface.tensorHom_eq, Interface.parallel_attach, Interface.identity_attach, attach_resourceConverter] diff --git a/src/ConstructiveCryptography/ConverterCoherence.lean b/src/ConstructiveCryptography/ConverterCoherence.lean index 02a9bd7..345543b 100644 --- a/src/ConstructiveCryptography/ConverterCoherence.lean +++ b/src/ConstructiveCryptography/ConverterCoherence.lean @@ -25,7 +25,7 @@ variable {A B C D E F : Interface} /-- On deterministic samples, the two sides of associator naturality have the same transcripts. -/ -theorem replies_associator_iff {ba bb bc : ℕ} (ha : IsDDCFrom D.domain A.domain ba a) +lemma replies_associator_iff {ba bb bc : ℕ} (ha : IsDDCFrom D.domain A.domain ba a) (hb : IsDDCFrom E.domain B.domain bb b) (hc : IsDDCFrom F.domain C.domain bc c) {rD : InsideOutsideSystem ((D.I ⊕ E.I) ⊕ F.I) (D.I ⊕ (E.I ⊕ F.I)) (tensor (tensor D E) F).X (tensor (tensor D E) F).Y @@ -68,7 +68,7 @@ theorem replies_associator_iff {ba bb bc : ℕ} (ha : IsDDCFrom D.domain A.domai (((replies_trim_iff _ _ _).mp hr).serialM_mono hA (fun _ _ hy => hy)) /-- **The associator is natural.** -/ -theorem comp_associator (α : A ⟶ D) (β : B ⟶ E) (γ : C ⟶ F) : +lemma comp_associator (α : A ⟶ D) (β : B ⟶ E) (γ : C ⟶ F) : parallelConverter (parallelConverter α β) γ ≫ (associator D E F).hom = (associator A B C).hom ≫ parallelConverter α (parallelConverter β γ) := by obtain ⟨rD, hrD, hD, hDle⟩ := exists_rename_eq_ofDDC (A := tensor (tensor D E) F) @@ -100,7 +100,7 @@ theorem comp_associator (α : A ⟶ D) (β : B ⟶ E) (γ : C ⟶ F) : exact replies_associator_iff p.1.2 p.2.1.2 p.2.2.2 hrD hrA hDle hAle h /-- The identity on the unit interface is the forwarding converter. -/ -theorem filter_unit : +lemma filter_unit : (DDC.filter (Y := unit.Y) (fun h => h = [] ∨ unit.domain h) (prefix_or_nil unit.nonempty_prefix.2)).1 = idConverter unit.I unit.X unit.Y := by funext h @@ -112,7 +112,7 @@ theorem filter_unit : /-- On deterministic samples, the two sides of left-unitor naturality have the same transcripts. -/ -theorem replies_leftUnitor_iff {ba : ℕ} (ha : IsDDCFrom D.domain A.domain ba a) +lemma replies_leftUnitor_iff {ba : ℕ} (ha : IsDDCFrom D.domain A.domain ba a) {rD : InsideOutsideSystem (Empty ⊕ D.I) D.I (tensor unit D).X (tensor unit D).Y D.X D.Y} {rA : InsideOutsideSystem (Empty ⊕ A.I) A.I (tensor unit A).X (tensor unit A).Y A.X A.Y} (hrD : IsDDCFrom D.domain (tensor unit D).domain 1 rD) @@ -144,7 +144,7 @@ theorem replies_leftUnitor_iff {ba : ℕ} (ha : IsDDCFrom D.domain A.domain ba a /-- On deterministic samples, the two sides of right-unitor naturality have the same transcripts. -/ -theorem replies_rightUnitor_iff {ba : ℕ} (ha : IsDDCFrom D.domain A.domain ba a) +lemma replies_rightUnitor_iff {ba : ℕ} (ha : IsDDCFrom D.domain A.domain ba a) {rD : InsideOutsideSystem (D.I ⊕ Empty) D.I (tensor D unit).X (tensor D unit).Y D.X D.Y} {rA : InsideOutsideSystem (A.I ⊕ Empty) A.I (tensor A unit).X (tensor A unit).Y A.X A.Y} (hrD : IsDDCFrom D.domain (tensor D unit).domain 1 rD) @@ -175,7 +175,7 @@ theorem replies_rightUnitor_iff {ba : ℕ} (ha : IsDDCFrom D.domain A.domain ba (((replies_trim_iff _ _ _).mp hr).serialM_mono hA (fun _ _ hy => hy)) /-- **The left unitor is natural.** -/ -theorem comp_leftUnitor (α : A ⟶ D) : +lemma comp_leftUnitor (α : A ⟶ D) : parallelConverter (𝟙 unit) α ≫ (leftUnitor D).hom = (leftUnitor A).hom ≫ α := by obtain ⟨rD, hrD, hD, hDle⟩ := exists_rename_eq_ofDDC (A := tensor unit D) (B := D) _ _ _ (leftUnitAlphabet_fst D.X) @@ -201,7 +201,7 @@ theorem comp_leftUnitor (α : A ⟶ D) : exact replies_leftUnitor_iff p.2 hrD hrA hDle hAle h /-- **The right unitor is natural.** -/ -theorem comp_rightUnitor (α : A ⟶ D) : +lemma comp_rightUnitor (α : A ⟶ D) : parallelConverter α (𝟙 unit) ≫ (rightUnitor D).hom = (rightUnitor A).hom ≫ α := by obtain ⟨rD, hrD, hD, hDle⟩ := exists_rename_eq_ofDDC (A := tensor D unit) (B := D) _ _ _ (rightUnitAlphabet_fst D.X) diff --git a/src/ConstructiveCryptography/CryptographicAlgebra/Basic.lean b/src/ConstructiveCryptography/CryptographicAlgebra/Basic.lean index f9dd5cb..f19c96b 100644 --- a/src/ConstructiveCryptography/CryptographicAlgebra/Basic.lean +++ b/src/ConstructiveCryptography/CryptographicAlgebra/Basic.lean @@ -115,7 +115,7 @@ instance instHSMulConverterResource {A B : C} : HSMul (A ⟶ B) (Phi B) (Phi A) omit [MonoidalCategory C] in @[simp] -theorem smul_eq_attach {A B : C} (converter : A ⟶ B) (resource : Phi B) : +lemma smul_eq_attach {A B : C} (converter : A ⟶ B) (resource : Phi B) : (converter • resource : Phi A) = attach converter resource := rfl @@ -136,13 +136,13 @@ def dummy [CryptographicAlgebra C Phi] : Phi (𝟙_ C) := LaxMonoidal.ε (ResourceTheory.functor C Phi) PUnit.unit @[simp] -theorem converter_parallel_identity (A B : C) : +lemma converter_parallel_identity (A B : C) : (𝟙 A) ⊗ₘ (𝟙 B) = 𝟙 (A ⊗ B) := by -- The ordered tensor bifunctor preserves identities. simp /-- Ordered converter parallel preserves serial composition. -/ -theorem converter_parallel_serial +lemma converter_parallel_serial {A B D E G H : C} (leftFirst : A ⟶ B) (leftSecond : B ⟶ D) (rightFirst : E ⟶ G) (rightSecond : G ⟶ H) : @@ -179,7 +179,7 @@ Jost, Section 2.2.2 (printed p. 17): “A finite set of resources with disjoint interface sets can be viewed as a single one.” The equation below is the associativity law of this library's selected binary packaging; Jost does not postulate a monoidal category. -/ -theorem parallel_assoc [CryptographicAlgebra C Phi] {A B D : C} +lemma parallel_assoc [CryptographicAlgebra C Phi] {A B D : C} (left : Phi A) (middle : Phi B) (right : Phi D) : attach (α_ A B D).inv @@ -193,7 +193,7 @@ theorem parallel_assoc [CryptographicAlgebra C Phi] {A B D : C} exact types_congr_hom associativity ((left, middle), right) @[simp] -theorem parallel_dummy_left [CryptographicAlgebra C Phi] {A : C} +lemma parallel_dummy_left [CryptographicAlgebra C Phi] {A : C} (resource : Phi A) : attach (λ_ A).inv (parallel (dummy (C := C)) resource) = @@ -208,7 +208,7 @@ theorem parallel_dummy_left [CryptographicAlgebra C Phi] {A : C} exact types_congr_hom unitality (PUnit.unit, resource) |>.symm @[simp] -theorem parallel_dummy_right [CryptographicAlgebra C Phi] {A : C} +lemma parallel_dummy_right [CryptographicAlgebra C Phi] {A : C} (resource : Phi A) : attach (ρ_ A).inv (parallel resource (dummy (C := C))) = @@ -231,12 +231,12 @@ abbrev map {A B : C} (converter : A ⟶ B) omit [MonoidalCategory C] in @[simp] -theorem map_identity {A : C} (source : Specification (Phi A)) : +lemma map_identity {A : C} (source : Specification (Phi A)) : map (𝟙 A) source = source := by simp [map, attach_identity] omit [MonoidalCategory C] in -theorem map_serial {A B D : C} (first : A ⟶ B) (second : B ⟶ D) +lemma map_serial {A B D : C} (first : A ⟶ B) (second : B ⟶ D) (source : Specification (Phi D)) : map (first ≫ second) source = map first (map second source) := by @@ -255,7 +255,7 @@ def parallel [CryptographicAlgebra C Phi] {A B : C} /-- Ordered parallel of singleton specifications is the singleton containing the ordered parallel resource. -/ @[simp] -theorem parallel_singleton [CryptographicAlgebra C Phi] {A B : C} +lemma parallel_singleton [CryptographicAlgebra C Phi] {A B : C} (left : Phi A) (right : Phi B) : parallel ({left} : Specification (Phi A)) ({right} : Specification (Phi B)) = @@ -274,7 +274,7 @@ def dummy [CryptographicAlgebra C Phi] : Specification (Phi (𝟙_ C)) := /-- Ordered specification parallel is associative through the routed associator. -/ -theorem parallel_assoc [CryptographicAlgebra C Phi] {A B D : C} +lemma parallel_assoc [CryptographicAlgebra C Phi] {A B D : C} (left : Specification (Phi A)) (middle : Specification (Phi B)) (right : Specification (Phi D)) : map (α_ A B D).inv @@ -307,7 +307,7 @@ theorem parallel_assoc [CryptographicAlgebra C Phi] {A B D : C} leftResource middleResource rightResource @[simp] -theorem parallel_dummy_left [CryptographicAlgebra C Phi] {A : C} +lemma parallel_dummy_left [CryptographicAlgebra C Phi] {A : C} (source : Specification (Phi A)) : map (λ_ A).inv (parallel (dummy (C := C)) source) = @@ -334,7 +334,7 @@ theorem parallel_dummy_left [CryptographicAlgebra C Phi] {A : C} exact CryptographicAlgebra.parallel_dummy_left resource @[simp] -theorem parallel_dummy_right [CryptographicAlgebra C Phi] {A : C} +lemma parallel_dummy_right [CryptographicAlgebra C Phi] {A : C} (source : Specification (Phi A)) : map (ρ_ A).inv (parallel source (dummy (C := C))) = @@ -372,7 +372,7 @@ abbrev Constructs {A B : C} (converter : A ⟶ B) omit [MonoidalCategory C] in /-- Exact construction holds exactly when every admitted resource is carried into the target specification. -/ -theorem constructs_iff {A B : C} {converter : A ⟶ B} +lemma constructs_iff {A B : C} {converter : A ⟶ B} {source : Specification (Phi B)} {target : Specification (Phi A)} : Constructs converter source target ↔ ∀ resource ∈ source, @@ -385,7 +385,7 @@ covariant in its target specification. Maurer--Renner 2016, Section 2.3 (printed p. 5): “`R —γ→ S =⇒ R′ —γ→ S′` if `R′ ⊆ R` and `S ⊆ S′`.” -/ -theorem Constructs.mono {A B : C} {converter : A ⟶ B} +lemma Constructs.mono {A B : C} {converter : A ⟶ B} {source source' : Specification (Phi B)} {target target' : Specification (Phi A)} (construction : Constructs converter source target) @@ -399,7 +399,7 @@ omit [MonoidalCategory C] in Jost--Maurer 2020, Definition 1 (printed p. 9): “In slight abuse of notation, we write `R —π→ S` in lieu of `{R} —π→ {S}`.” -/ -theorem constructs_singleton_iff {A B : C} {converter : A ⟶ B} +lemma constructs_singleton_iff {A B : C} {converter : A ⟶ B} {source : Phi B} {target : Phi A} : Constructs converter ({source} : Specification (Phi B)) ({target} : Specification (Phi A)) ↔ @@ -410,7 +410,7 @@ theorem constructs_singleton_iff {A B : C} {converter : A ⟶ B} omit [MonoidalCategory C] in /-- Equal converters between the same interfaces have equal attachment on every resource. -/ -theorem attach_eq_of_converter_eq {A B : C} {left right : A ⟶ B} +lemma attach_eq_of_converter_eq {A B : C} {left right : A ⟶ B} (equal : left = right) (resource : Phi B) : attach left resource = attach right resource := by -- Substitute the converter equality in the functor map. @@ -419,7 +419,7 @@ theorem attach_eq_of_converter_eq {A B : C} {left right : A ⟶ B} omit [MonoidalCategory C] in /-- Exact construction is invariant under equality of converters between the same interfaces. -/ -theorem constructs_iff_of_converter_eq {A B : C} {left right : A ⟶ B} +lemma constructs_iff_of_converter_eq {A B : C} {left right : A ⟶ B} (equal : left = right) {source : Specification (Phi B)} {target : Specification (Phi A)} : Constructs left source target ↔ @@ -430,7 +430,7 @@ theorem constructs_iff_of_converter_eq {A B : C} {left right : A ⟶ B} omit [MonoidalCategory C] in @[simp] -theorem constructs_identity {A : C} (source : Specification (Phi A)) : +lemma constructs_identity {A : C} (source : Specification (Phi A)) : Constructs (𝟙 A) source source := by intro resource admitted simpa [attach_identity] using admitted @@ -536,7 +536,7 @@ theorem Constructs.parallel [CryptographicAlgebra C Phi] /-- Left context-insensitivity: an exact construction remains valid beside an unchanged right-hand resource specification. -/ -theorem Constructs.left_context [CryptographicAlgebra C Phi] +lemma Constructs.left_context [CryptographicAlgebra C Phi] {A A' B : C} {converter : A ⟶ A'} {source : Specification (Phi A')} {target : Specification (Phi A)} (construction : Constructs converter source target) @@ -549,7 +549,7 @@ theorem Constructs.left_context [CryptographicAlgebra C Phi] /-- Right context-insensitivity: an exact construction remains valid beside an unchanged left-hand resource specification. -/ -theorem Constructs.right_context [CryptographicAlgebra C Phi] +lemma Constructs.right_context [CryptographicAlgebra C Phi] {A B B' : C} {converter : B ⟶ B'} {source : Specification (Phi B')} {target : Specification (Phi B)} (context : Specification (Phi A)) diff --git a/src/ConstructiveCryptography/CryptographicAlgebra/Distinguisher.lean b/src/ConstructiveCryptography/CryptographicAlgebra/Distinguisher.lean index 49b6fa2..fac87dc 100644 --- a/src/ConstructiveCryptography/CryptographicAlgebra/Distinguisher.lean +++ b/src/ConstructiveCryptography/CryptographicAlgebra/Distinguisher.lean @@ -37,12 +37,12 @@ noncomputable def advantageDistance {X : Type*} (distinguishers : Set (X → ℝ ENNReal := ⨆ d ∈ distinguishers, ENNReal.ofReal |d R - d S| -theorem advantageDistance_le {X : Type*} {distinguishers : Set (X → ℝ)} {R S : X} +lemma advantageDistance_le {X : Type*} {distinguishers : Set (X → ℝ)} {R S : X} {ε : ENNReal} (h : ∀ d ∈ distinguishers, ENNReal.ofReal |d R - d S| ≤ ε) : advantageDistance distinguishers R S ≤ ε := iSup₂_le h -theorem le_advantageDistance {X : Type*} {distinguishers : Set (X → ℝ)} {d : X → ℝ} +lemma le_advantageDistance {X : Type*} {distinguishers : Set (X → ℝ)} {d : X → ℝ} (hd : d ∈ distinguishers) (R S : X) : ENNReal.ofReal |d R - d S| ≤ advantageDistance distinguishers R S := le_iSup₂ (f := fun d (_ : d ∈ distinguishers) => ENNReal.ofReal |d R - d S|) d hd diff --git a/src/ConstructiveCryptography/CryptographicAlgebra/Epsilon.lean b/src/ConstructiveCryptography/CryptographicAlgebra/Epsilon.lean index 79f8aa3..49d3f34 100644 --- a/src/ConstructiveCryptography/CryptographicAlgebra/Epsilon.lean +++ b/src/ConstructiveCryptography/CryptographicAlgebra/Epsilon.lean @@ -46,7 +46,7 @@ noncomputable def epsilonRelaxation {A : C} (error : ENNReal) (CompatiblePseudoMetric.fibreMetric A) error @[simp] -theorem mem_epsilonRelaxation_iff {A : C} {error : ENNReal} +lemma mem_epsilonRelaxation_iff {A : C} {error : ENNReal} {source : Specification (Phi A)} {resource : Phi A} : resource ∈ epsilonRelaxation error source ↔ ∃ center ∈ source, @@ -55,14 +55,14 @@ theorem mem_epsilonRelaxation_iff {A : C} {error : ENNReal} /-- Every specification is contained in each of its scalar-error relaxations. -/ -theorem subset_epsilonRelaxation {A : C} (error : ENNReal) +lemma subset_epsilonRelaxation {A : C} (error : ENNReal) (source : Specification (Phi A)) : source ⊆ epsilonRelaxation error source := by -- Extensivity is part of the relaxation object. exact (epsilonRelaxation error).subset_apply source /-- Scalar-error relaxation is monotone in the underlying specification. -/ -theorem epsilonRelaxation_mono {A : C} {error : ENNReal} +lemma epsilonRelaxation_mono {A : C} {error : ENNReal} {source target : Specification (Phi A)} (included : source ⊆ target) : epsilonRelaxation error source ⊆ epsilonRelaxation error target := by @@ -124,7 +124,7 @@ theorem parallel_epsilonRelaxation_left_subset {A B : C} /-- Relaxing the right component before ordered parallel is contained in relaxing the resulting parallel specification. -/ -theorem parallel_epsilonRelaxation_right_subset {A B : C} +lemma parallel_epsilonRelaxation_right_subset {A B : C} (error : ENNReal) (context : Specification (Phi A)) (source : Specification (Phi B)) : parallel context @@ -143,7 +143,7 @@ theorem parallel_epsilonRelaxation_right_subset {A B : C} /-- The scalar-error relaxation family is compatible with converter attachment. -/ -theorem epsilonRelaxation_compatible (error : ENNReal) : +lemma epsilonRelaxation_compatible (error : ENNReal) : Relaxation.Compatible (Phi := Phi) (fun A => epsilonRelaxation (A := A) error) := by intro A B converter source @@ -152,7 +152,7 @@ theorem epsilonRelaxation_compatible (error : ENNReal) : /-- The scalar-error relaxation family is compatible with ordered parallel composition. -/ -theorem epsilonRelaxation_parallelCompatible (error : ENNReal) : +lemma epsilonRelaxation_parallelCompatible (error : ENNReal) : Relaxation.ParallelCompatible (Phi := Phi) (fun A => epsilonRelaxation (A := A) error) := by intro A B left right @@ -162,7 +162,7 @@ theorem epsilonRelaxation_parallelCompatible (error : ENNReal) : /-- Exact construction into a scalar-error relaxation is equivalent to approximate construction in the selected fibre distance. -/ -theorem constructs_epsilonRelaxation_iff {A B : C} +lemma constructs_epsilonRelaxation_iff {A B : C} {converter : A ⟶ B} {source : Specification (Phi B)} {target : Specification (Phi A)} {error : ENNReal} : Constructs converter source @@ -201,7 +201,7 @@ theorem Constructs.epsilonRelaxation {A B : C} /-- Singleton exact construction into a scalar-error relaxation is exactly a distance bound between the attached real resource and the ideal resource. -/ -theorem constructs_singleton_epsilonRelaxation_iff {A B : C} +lemma constructs_singleton_epsilonRelaxation_iff {A B : C} {converter : A ⟶ B} {real : Phi B} {ideal : Phi A} {error : ENNReal} : Constructs converter ({real} : Specification (Phi B)) @@ -219,7 +219,7 @@ theorem constructs_singleton_epsilonRelaxation_iff {A B : C} Maurer--Renner 2016, Lemma 1 (printed p. 11): “This construction notion is composable.” Jost--Maurer 2020, Corollary 1(1) (printed p. 11) states the serial construction with the two relaxation budgets added: “The composition -theorem with ϵ-relaxations then follows directly from these compatibility +lemma with ϵ-relaxations then follows directly from these compatibility results.” Lean specializes its transformed budgets to constant scalar bounds under non-expansion. -/ theorem Constructs.serial_epsilonRelaxation {A B D : C} diff --git a/src/ConstructiveCryptography/CryptographicAlgebra/Game.lean b/src/ConstructiveCryptography/CryptographicAlgebra/Game.lean index d56db58..5e221fe 100644 --- a/src/ConstructiveCryptography/CryptographicAlgebra/Game.lean +++ b/src/ConstructiveCryptography/CryptographicAlgebra/Game.lean @@ -84,7 +84,7 @@ instance instHSMulConverterGame {A B : C} : HSMul (A ⟶ B) (Game B) (Game A) wh hSMul := attachGame @[simp] -theorem smul_eq_attachGame {A B : C} (converter : A ⟶ B) (game : Game B) : +lemma smul_eq_attachGame {A B : C} (converter : A ⟶ B) (game : Game B) : (converter • game : Game A) = attachGame converter game := rfl @@ -93,12 +93,12 @@ converter attached (CR18, §4.7.2, equation (4.10), `C G = G ∘ ρ_C`). -/ def absorb {A B : C} (converter : A ⟶ B) (winner : Game A → ℝ) : Game B → ℝ := fun game => winner (attachGame converter game) -theorem absorb_mem {A B : C} (converter : A ⟶ B) {winner : Game A → ℝ} +lemma absorb_mem {A B : C} (converter : A ⟶ B) {winner : Game A → ℝ} (h : winner ∈ winners A) : absorb converter winner ∈ winners B := closed_attach converter h /-- **Absorbing a serial composition** absorbs its converters in turn. -/ -theorem absorb_comp {A B D : C} (first : A ⟶ B) (second : B ⟶ D) (winner : Game A → ℝ) : +lemma absorb_comp {A B D : C} (first : A ⟶ B) (second : B ⟶ D) (winner : Game A → ℝ) : absorb (first ≫ second) winner = absorb second (absorb first winner) := funext fun game => congrArg winner (attachGame_serial first second game) @@ -149,7 +149,7 @@ def absorb {A B : C} (converter : A ⟶ B) (solver : (Phi A → ℝ) × (Game A (Phi B → ℝ) × (Game B → ℝ) := (fun R => solver.1 (ResourceTheory.attach converter R), Games.absorb converter solver.2) -theorem absorb_mem {A B : C} (converter : A ⟶ B) {solver : (Phi A → ℝ) × (Game A → ℝ)} +lemma absorb_mem {A B : C} (converter : A ⟶ B) {solver : (Phi A → ℝ) × (Game A → ℝ)} (h : solver ∈ solvers A) : absorb converter solver ∈ solvers B := solvers_closed_attach converter h diff --git a/src/ConstructiveCryptography/CryptographicAlgebra/PseudoMetric.lean b/src/ConstructiveCryptography/CryptographicAlgebra/PseudoMetric.lean index 08d2530..1e434cb 100644 --- a/src/ConstructiveCryptography/CryptographicAlgebra/PseudoMetric.lean +++ b/src/ConstructiveCryptography/CryptographicAlgebra/PseudoMetric.lean @@ -65,20 +65,20 @@ noncomputable def distance [CompatiblePseudoMetric C Phi] {A : C} @edist _ (CompatiblePseudoMetric.fibreMetric A).toEDist left right @[simp] -theorem distance_self [CompatiblePseudoMetric C Phi] {A : C} +lemma distance_self [CompatiblePseudoMetric C Phi] {A : C} (resource : Phi A) : distance resource resource = 0 := by let := CompatiblePseudoMetric.fibreMetric (Phi := Phi) A exact edist_self resource /-- Symmetry of the selected resource distance. -/ -theorem distance_comm [CompatiblePseudoMetric C Phi] {A : C} +lemma distance_comm [CompatiblePseudoMetric C Phi] {A : C} (left right : Phi A) : distance left right = distance right left := by let := CompatiblePseudoMetric.fibreMetric (Phi := Phi) A exact edist_comm left right -theorem distance_triangle [CompatiblePseudoMetric C Phi] {A : C} +lemma distance_triangle [CompatiblePseudoMetric C Phi] {A : C} (left middle right : Phi A) : distance left right ≤ distance left middle + @@ -87,7 +87,7 @@ theorem distance_triangle [CompatiblePseudoMetric C Phi] {A : C} exact edist_triangle left middle right /-- Converter attachment is non-expanding in the selected fibre distances. -/ -theorem distance_attach_le [CompatiblePseudoMetric C Phi] {A B : C} +lemma distance_attach_le [CompatiblePseudoMetric C Phi] {A B : C} (converter : A ⟶ B) (left right : Phi B) : distance (attach converter left) (attach converter right) ≤ @@ -117,7 +117,7 @@ theorem distance_attach_le_add_of_eq [CompatiblePseudoMetric C Phi] {A B : C} /-- Attachment along an interface isomorphism preserves the selected fibre distance exactly. -/ -theorem distance_attach_iso [CompatiblePseudoMetric C Phi] {A B : C} +lemma distance_attach_iso [CompatiblePseudoMetric C Phi] {A B : C} (relabel : A ≅ B) (left right : Phi B) : distance (attach relabel.hom left) (attach relabel.hom right) = @@ -142,7 +142,7 @@ theorem distance_attach_iso [CompatiblePseudoMetric C Phi] {A B : C} distance_attach_le relabel.inv _ _ /-- Ordered resource parallel is jointly non-expanding. -/ -theorem distance_parallel_le [CompatiblePseudoMetric C Phi] {A B : C} +lemma distance_parallel_le [CompatiblePseudoMetric C Phi] {A B : C} (left left' : Phi A) (right right' : Phi B) : distance (parallel left right) (parallel left' right') ≤ @@ -152,7 +152,7 @@ theorem distance_parallel_le [CompatiblePseudoMetric C Phi] {A B : C} /-- Ordered parallel with an unchanged right component is non-expanding in the left component. -/ -theorem distance_parallel_left_le [CompatiblePseudoMetric C Phi] {A B : C} +lemma distance_parallel_left_le [CompatiblePseudoMetric C Phi] {A B : C} (left left' : Phi A) (right : Phi B) : distance (parallel left right) (parallel left' right) ≤ @@ -163,7 +163,7 @@ theorem distance_parallel_left_le [CompatiblePseudoMetric C Phi] {A B : C} /-- Ordered parallel with an unchanged left component is non-expanding in the right component. -/ -theorem distance_parallel_right_le [CompatiblePseudoMetric C Phi] {A B : C} +lemma distance_parallel_right_le [CompatiblePseudoMetric C Phi] {A B : C} (left : Phi A) (right right' : Phi B) : distance (parallel left right) (parallel left right') ≤ @@ -186,7 +186,7 @@ abbrev ConstructsWithin [CompatiblePseudoMetric C Phi] {A B : C} /-- Approximate construction holds exactly when every admitted source resource attaches within the error bound of an admitted target resource. -/ -theorem constructsWithin_iff [CompatiblePseudoMetric C Phi] {A B : C} +lemma constructsWithin_iff [CompatiblePseudoMetric C Phi] {A B : C} {converter : A ⟶ B} {source : Specification (Phi B)} {target : Specification (Phi A)} {error : ENNReal} : ConstructsWithin converter source target error ↔ @@ -198,7 +198,7 @@ theorem constructsWithin_iff [CompatiblePseudoMetric C Phi] {A B : C} /-- Singleton approximate construction is exactly the selected fibre-distance bound after converter attachment. -/ -theorem constructsWithin_singleton_iff [CompatiblePseudoMetric C Phi] {A B : C} +lemma constructsWithin_singleton_iff [CompatiblePseudoMetric C Phi] {A B : C} {converter : A ⟶ B} {source : Phi B} {target : Phi A} {error : ENNReal} : ConstructsWithin converter @@ -212,7 +212,7 @@ theorem constructsWithin_singleton_iff [CompatiblePseudoMetric C Phi] {A B : C} /-- Approximate construction is invariant under equality of converters between the same interfaces. -/ -theorem constructsWithin_iff_of_converter_eq [CompatiblePseudoMetric C Phi] +lemma constructsWithin_iff_of_converter_eq [CompatiblePseudoMetric C Phi] {A B : C} {left right : A ⟶ B} (equal : left = right) {source : Specification (Phi B)} {target : Specification (Phi A)} {error : ENNReal} : @@ -223,7 +223,7 @@ theorem constructsWithin_iff_of_converter_eq [CompatiblePseudoMetric C Phi] rfl @[simp] -theorem constructsWithin_identity [CompatiblePseudoMetric C Phi] {A : C} +lemma constructsWithin_identity [CompatiblePseudoMetric C Phi] {A : C} (source : Specification (Phi A)) : ConstructsWithin (𝟙 A) source source 0 := by let := CompatiblePseudoMetric.fibreMetric (Phi := Phi) A @@ -231,7 +231,7 @@ theorem constructsWithin_identity [CompatiblePseudoMetric C Phi] {A : C} exact ⟨resource, member, by simp [attach_identity]⟩ /-- Approximate constructions compose serially with additive error. -/ -theorem ConstructsWithin.serial [CompatiblePseudoMetric C Phi] +lemma ConstructsWithin.serial [CompatiblePseudoMetric C Phi] {A B D : C} {first : A ⟶ B} {second : B ⟶ D} {source : Specification (Phi D)} {middle : Specification (Phi B)} {target : Specification (Phi A)} {innerError outerError : ENNReal} @@ -251,7 +251,7 @@ theorem ConstructsWithin.serial [CompatiblePseudoMetric C Phi] /-- Approximate constructions compose in ordered parallel with additive error. -/ -theorem ConstructsWithin.parallel [CompatiblePseudoMetric C Phi] +lemma ConstructsWithin.parallel [CompatiblePseudoMetric C Phi] {A A' B B' : C} {leftConverter : A ⟶ A'} {rightConverter : B ⟶ B'} {leftSource : Specification (Phi A')} {leftTarget : Specification (Phi A)} @@ -276,7 +276,7 @@ theorem ConstructsWithin.parallel [CompatiblePseudoMetric C Phi] (attach_parallel leftConverter rightConverter) (distance_parallel_le) /-- Left context-insensitivity for approximate construction. -/ -theorem ConstructsWithin.left_context [CompatiblePseudoMetric C Phi] +lemma ConstructsWithin.left_context [CompatiblePseudoMetric C Phi] {A A' B : C} {converter : A ⟶ A'} {source : Specification (Phi A')} {target : Specification (Phi A)} {error : ENNReal} @@ -293,7 +293,7 @@ theorem ConstructsWithin.left_context [CompatiblePseudoMetric C Phi] (fun x y => by rw [attach_parallel, attach_identity]) (distance_parallel_left_le) /-- Right context-insensitivity for approximate construction. -/ -theorem ConstructsWithin.right_context [CompatiblePseudoMetric C Phi] +lemma ConstructsWithin.right_context [CompatiblePseudoMetric C Phi] {A B B' : C} {converter : B ⟶ B'} {source : Specification (Phi B')} {target : Specification (Phi B)} {error : ENNReal} diff --git a/src/ConstructiveCryptography/CryptographicAlgebra/Relaxation.lean b/src/ConstructiveCryptography/CryptographicAlgebra/Relaxation.lean index f6544ef..ac8907e 100644 --- a/src/ConstructiveCryptography/CryptographicAlgebra/Relaxation.lean +++ b/src/ConstructiveCryptography/CryptographicAlgebra/Relaxation.lean @@ -66,7 +66,7 @@ def ParallelCompatible omit [MonoidalCategory C] [CryptographicAlgebra C Phi] in /-- Pointwise composition of compatible relaxation families is compatible. -/ -theorem Compatible.comp +lemma Compatible.comp {outer inner : (A : C) → ConstructiveCryptography.Relaxation (Phi A)} (outerCompatible : Compatible outer) @@ -81,7 +81,7 @@ theorem Compatible.comp omit [MonoidalCategory C] [CryptographicAlgebra C Phi] in /-- Converter compatibility is equivalent to preservation of exact construction under the relaxation family. -/ -theorem compatible_iff +lemma compatible_iff (relaxation : (A : C) → ConstructiveCryptography.Relaxation (Phi A)) : Compatible relaxation ↔ @@ -133,7 +133,7 @@ theorem Constructs.relax {A B : C} {converter : A ⟶ B} omit [MonoidalCategory C] [CryptographicAlgebra C Phi] in /-- Pull a compatible relaxation through the outer leg of a serial construction. -/ -theorem Constructs.relax_serial +lemma Constructs.relax_serial {relaxation : (A : C) → ConstructiveCryptography.Relaxation (Phi A)} (compatible : Relaxation.Compatible relaxation) @@ -160,7 +160,7 @@ theorem Constructs.relax_serial /-- Put an exact construction into an unchanged right context and pull a parallel-compatible relaxation around the result. -/ -theorem Constructs.relax_left_context +lemma Constructs.relax_left_context {relaxation : (A : C) → ConstructiveCryptography.Relaxation (Phi A)} (parallelCompatible : @@ -185,7 +185,7 @@ theorem Constructs.relax_left_context right, contextAdmitted, rfl⟩ /-- Right-context counterpart of `Constructs.relax_left_context`. -/ -theorem Constructs.relax_right_context +lemma Constructs.relax_right_context {relaxation : (A : C) → ConstructiveCryptography.Relaxation (Phi A)} (parallelCompatible : diff --git a/src/ConstructiveCryptography/CryptographicAlgebra/Star.lean b/src/ConstructiveCryptography/CryptographicAlgebra/Star.lean index b47622b..ac3a8a5 100644 --- a/src/ConstructiveCryptography/CryptographicAlgebra/Star.lean +++ b/src/ConstructiveCryptography/CryptographicAlgebra/Star.lean @@ -65,7 +65,7 @@ noncomputable abbrev star {A : C} omit [MonoidalCategory C] in /-- Membership in converter-class closure, expressed with ordinary base converters. -/ -theorem mem_star_iff {A : C} +lemma mem_star_iff {A : C} {converters : EndoFamily A} {source : Specification (Phi A)} {resource : Phi A} : resource ∈ star converters source ↔ @@ -82,7 +82,7 @@ theorem mem_star_iff {A : C} omit [MonoidalCategory C] in /-- Every specification is contained in its converter-class closure. -/ -theorem subset_star {A : C} +lemma subset_star {A : C} (converters : EndoFamily A) (source : Specification (Phi A)) : source ⊆ star converters source := by @@ -91,7 +91,7 @@ theorem subset_star {A : C} omit [MonoidalCategory C] in /-- Converter-class closure is idempotent. -/ -theorem star_idem {A : C} +lemma star_idem {A : C} (converters : EndoFamily A) (source : Specification (Phi A)) : star converters @@ -102,7 +102,7 @@ theorem star_idem {A : C} omit [MonoidalCategory C] in /-- A larger admitted converter class gives a larger star relaxation. -/ -theorem star_mono {A : C} +lemma star_mono {A : C} {converters converters' : EndoFamily A} (included : converters ≤ converters') (source : Specification (Phi A)) : star converters source ⊆ @@ -117,7 +117,7 @@ theorem star_mono {A : C} omit [MonoidalCategory C] in /-- Converter attachment carries a star-relaxed source into the star closure of its direct image when the converter commutes with the admitted class. -/ -theorem map_star_subset {A : C} {converter : CategoryTheory.End A} +lemma map_star_subset {A : C} {converter : CategoryTheory.End A} {converters : EndoFamily A} (commutes : ∀ classConverter : CategoryTheory.End A, classConverter.op ∈ converters → @@ -163,7 +163,7 @@ theorem Constructs.star {A : C} {converter : CategoryTheory.End A} /-- Approximate construction remains valid after star-relaxing both endpoints when the constructing converter commutes with the admitted class. -/ -theorem ConstructsWithin.star [CompatiblePseudoMetric C Phi] {A : C} +lemma ConstructsWithin.star [CompatiblePseudoMetric C Phi] {A : C} {converter : CategoryTheory.End A} {converters : EndoFamily A} {source target : Specification (Phi A)} {error : ENNReal} @@ -191,7 +191,7 @@ converter-class-relaxed ideal. Maurer--Renner 2016, Section 4.3 (printed p. 13): an equality of the form “`πR = Tσ`” is read as membership of `πR` in `TΣ = T*`. -/ -theorem constructs_star_of_simulator {A B : C} +lemma constructs_star_of_simulator {A B : C} {converter : A ⟶ B} {converters : EndoFamily A} {real : Phi B} {ideal : Phi A} (simulator : CategoryTheory.End A) (admitted : simulator.op ∈ converters) @@ -209,7 +209,7 @@ singleton ideal. Maurer--Renner 2016, Section 4.2 (printed p. 12): a simulator is exhibited to prove the required construction; it is not part of the construction notion. -/ -theorem constructs_star_of_simulators {A B : C} +lemma constructs_star_of_simulators {A B : C} {converter : A ⟶ B} {converters : EndoFamily A} {real : Specification (Phi B)} {ideal : Phi A} (simulates : ∀ resource ∈ real, @@ -227,7 +227,7 @@ theorem constructs_star_of_simulators {A B : C} /-- An explicit simulator distance bound proves approximate construction into the converter-class-relaxed ideal. -/ -theorem constructsWithin_star_of_simulator [CompatiblePseudoMetric C Phi] {A B : C} +lemma constructsWithin_star_of_simulator [CompatiblePseudoMetric C Phi] {A B : C} {converter : A ⟶ B} {converters : EndoFamily A} {real : Phi B} {ideal : Phi A} {error : ENNReal} (simulator : CategoryTheory.End A) (admitted : simulator.op ∈ converters) @@ -243,7 +243,7 @@ theorem constructsWithin_star_of_simulator [CompatiblePseudoMetric C Phi] {A B : /-- Pointwise simulator distance witnesses prove approximate construction into a star-relaxed singleton ideal. -/ -theorem constructsWithin_star_of_simulators [CompatiblePseudoMetric C Phi] {A B : C} +lemma constructsWithin_star_of_simulators [CompatiblePseudoMetric C Phi] {A B : C} {converter : A ⟶ B} {converters : EndoFamily A} {real : Specification (Phi B)} {ideal : Phi A} {error : ENNReal} (simulates : ∀ resource ∈ real, diff --git a/src/ConstructiveCryptography/DDCCoherence.lean b/src/ConstructiveCryptography/DDCCoherence.lean index da1f08f..ee5292e 100644 --- a/src/ConstructiveCryptography/DDCCoherence.lean +++ b/src/ConstructiveCryptography/DDCCoherence.lean @@ -30,7 +30,7 @@ variable {A B C D E F : Interface} {c : InsideOutsideSystem C.I F.I C.X C.Y F.X F.Y} /-- Regrouping changes only the two ways to label the same three constituents. -/ -theorem tensorRaw_assoc : +lemma tensorRaw_assoc : relabel (tensorRaw (tensorRaw a b) c) (insideMap (assocAlphabet D.Y E.Y F.Y).symm) (insideMap (assocAlphabet D.X E.X F.X)) = @@ -50,7 +50,7 @@ theorem tensorRaw_assoc : · rcases z with ⟨⟨(_ | ⟨⟨⟩⟩), i⟩, z⟩ <;> rfl · rcases z with ⟨(_ | ⟨⟨⟩⟩), ⟨⟨(_ | ⟨⟨⟩⟩), i⟩, z⟩⟩ <;> rfl -theorem tensorRaw_unit_left (ha : SilentAtEmpty a) : +lemma tensorRaw_unit_left (ha : SilentAtEmpty a) : relabel (tensorRaw (idConverter unit.I unit.X unit.Y) a) (insideMap (leftUnitAlphabet D.Y).symm) (insideMap (leftUnitAlphabet D.X)) = relabel a (outsideMap (leftUnitAlphabet A.X)) (outsideMap (leftUnitAlphabet A.Y).symm) := by @@ -69,7 +69,7 @@ theorem tensorRaw_unit_left (ha : SilentAtEmpty a) : funext z rcases z with ⟨⟨(_ | ⟨⟨⟩⟩), i⟩, z⟩ <;> rfl -theorem tensorRaw_unit_right (ha : SilentAtEmpty a) : +lemma tensorRaw_unit_right (ha : SilentAtEmpty a) : relabel (tensorRaw a (idConverter unit.I unit.X unit.Y)) (insideMap (rightUnitAlphabet D.Y).symm) (insideMap (rightUnitAlphabet D.X)) = relabel a (outsideMap (rightUnitAlphabet A.X)) (outsideMap (rightUnitAlphabet A.Y).symm) := by @@ -96,7 +96,7 @@ variable {A B C D E F : Interface} {b : InsideOutsideSystem B.I E.I B.X B.Y E.X E.Y} {c : InsideOutsideSystem C.I F.I C.X C.Y F.X F.Y} -theorem trim_serialM_leftUnitor_of_isDDC {ba : ℕ} (ha : IsDDC ba a) : +lemma trim_serialM_leftUnitor_of_isDDC {ba : ℕ} (ha : IsDDC ba a) : trim (serialM (SystemAlgebra.tensorL (idConverter unit.I unit.X unit.Y) a) (renameConverter (leftUnitAlphabet D.X) (leftUnitAlphabet D.Y).symm)) = trim (serialM (renameConverter (leftUnitAlphabet A.X) (leftUnitAlphabet A.Y).symm) a) := by @@ -130,7 +130,7 @@ theorem trim_serialM_leftUnitor_of_isDDC {ba : ℕ} (ha : IsDDC ba a) : serialM_relabel_forwardAll _ _ _ ha.dds.1] · rw [ha.canon_eq]; exact ha -theorem trim_serialM_rightUnitor_of_isDDC {ba : ℕ} (ha : IsDDC ba a) : +lemma trim_serialM_rightUnitor_of_isDDC {ba : ℕ} (ha : IsDDC ba a) : trim (serialM (SystemAlgebra.tensorL a (idConverter unit.I unit.X unit.Y)) (renameConverter (rightUnitAlphabet D.X) (rightUnitAlphabet D.Y).symm)) = trim (serialM (renameConverter (rightUnitAlphabet A.X) (rightUnitAlphabet A.Y).symm) a) := by @@ -175,7 +175,7 @@ variable {A B C D E F : Interface} {c : InsideOutsideSystem C.I F.I C.X C.Y F.X F.Y} /-- The associator is natural for partial converters. -/ -theorem trim_serialM_associator_of_isDDC {ba bb bc : ℕ} +lemma trim_serialM_associator_of_isDDC {ba bb bc : ℕ} (ha : IsDDC ba a) (hb : IsDDC bb b) (hc : IsDDC bc c) : trim (serialM (SystemAlgebra.tensorL (SystemAlgebra.tensorL a b) c) (renameConverter (assocAlphabet D.X E.X F.X) (assocAlphabet D.Y E.Y F.Y).symm)) = diff --git a/src/ConstructiveCryptography/DSL/Converters.lean b/src/ConstructiveCryptography/DSL/Converters.lean index 7e18095..a273362 100644 --- a/src/ConstructiveCryptography/DSL/Converters.lean +++ b/src/ConstructiveCryptography/DSL/Converters.lean @@ -84,7 +84,7 @@ noncomputable def Interface.Converter.ofPreservingProgram {A B : Interface} (s : /-- An interface admitting the histories with at most `q o` queries at each label, beside `B`, admits the histories with at most `q o` queries at each left label and at most `k` queries in all, when `B` admits every nonempty history of at most `k`. -/ -theorem Interface.perPort_tensor_admits {A B : Interface} (q : A.I → ℕ) +lemma Interface.perPort_tensor_admits {A B : Interface} (q : A.I → ℕ) (hA : ∀ xs, xs ≠ [] → (∀ o, (SystemAlgebra.restrict o xs).length ≤ q o) → A.domain xs) {k : ℕ} (hB : ∀ xs, xs ≠ [] → xs.length ≤ k → B.domain xs) : ∀ ys, ys ≠ [] → ys.length ≤ k → (∀ o, (SystemAlgebra.restrict (Sum.inl o) ys).length ≤ q o) → @@ -100,7 +100,7 @@ theorem Interface.perPort_tensor_admits {A B : Interface} (q : A.I → ℕ) /-- **Attaching the converter of a program** to the resource of a PDS: a transcript has the mass of the resources on which the inlined program, on the outside domain, gives it. -/ -theorem Interface.ofDDC_ofProgramOn_smul_ofPDS {A B : Interface} (s : S) +lemma Interface.ofDDC_ofProgramOn_smul_ofPDS {A B : Interface} (s : S) (P : Program S A.I B.I A.X A.Y B.X B.Y) {b : ℕ} (hb : P.Bounded b) (hα : IsDDCFrom B.domain A.domain b (DDC.ofProgramOn s P A.domain)) (Q : Probability.Distribution.ProbDist {r : InterfaceSystem B.I B.X B.Y // @@ -118,7 +118,7 @@ theorem Interface.ofDDC_ofProgramOn_smul_ofPDS {A B : Interface} (s : S) /-- **Attaching the converter of a program to an automaton** gives the combined automaton, its initial state paired with the program's. -/ -theorem Interface.ofDDC_ofProgramOn_smul_ofAutomaton {A B : Interface} {R : Type} (s : S) +lemma Interface.ofDDC_ofProgramOn_smul_ofAutomaton {A B : Interface} {R : Type} (s : S) (P : Program S A.I B.I A.X A.Y B.X B.Y) {b : ℕ} (hb : P.Bounded b) (hα : IsDDCFrom B.domain A.domain b (DDC.ofProgramOn s P A.domain)) (stepR : R → (j : B.I) → B.X j → R × B.Y j) (initial : Probability.Distribution.ProbDist R) : @@ -139,7 +139,7 @@ theorem Interface.ofDDC_ofProgramOn_smul_ofAutomaton {A B : Interface} {R : Type rw [← Program.trim_apply_ofProgramOn s hb A.domain A.nonempty_prefix.2, Program.trim_apply_ofProgramOn_automaton stepR hb s r B.nonempty_prefix A.nonempty_prefix hα] -theorem Interface.Converter.ofProgram_smul_ofAutomaton {A B : Interface} {R : Type} (s : S) +lemma Interface.Converter.ofProgram_smul_ofAutomaton {A B : Interface} {R : Type} (s : S) (P : Program S A.I B.I A.X A.Y B.X B.Y) {b : ℕ} (hb : P.Bounded b) (hB : ∀ xs, xs ≠ [] → xs.length ≤ b * A.bound → B.domain xs) (stepR : R → (j : B.I) → B.X j → R × B.Y j) (initial : Probability.Distribution.ProbDist R) : @@ -149,7 +149,7 @@ theorem Interface.Converter.ofProgram_smul_ofAutomaton {A B : Interface} {R : Ty Probability.Distribution.fTransform_isProbDist _ initial.2⟩ := Interface.ofDDC_ofProgramOn_smul_ofAutomaton s P hb _ stepR initial -theorem Interface.Converter.ofPreservingProgram_smul_ofAutomaton {A B : Interface} {R : Type} +lemma Interface.Converter.ofPreservingProgram_smul_ofAutomaton {A B : Interface} {R : Type} (s : S) (P : Program S A.I B.I A.X A.Y B.X B.Y) {b : ℕ} (hb : P.Bounded b) (ι : A.I → Option B.I) (hι : P.PortPreserving ι) (q : A.I → ℕ) (hA : ∀ xs, A.domain xs → ∀ o, (SystemAlgebra.restrict o xs).length ≤ q o) diff --git a/src/ConstructiveCryptography/DSL/Programs.lean b/src/ConstructiveCryptography/DSL/Programs.lean index ce73608..44c3b12 100644 --- a/src/ConstructiveCryptography/DSL/Programs.lean +++ b/src/ConstructiveCryptography/DSL/Programs.lean @@ -40,7 +40,7 @@ abbrev lawType {T : Type} (_ : Distribution.ProbDist T) : Type := T abbrev TypeOf {T : Type} (_ : T) : Type := T /-- A total cost bound is closed under prefixes. -/ -theorem cost_prefix_closed {T : Type} (f : T → ℕ) (q : ℕ) : +lemma cost_prefix_closed {T : Type} (f : T → ℕ) (q : ℕ) : ∀ p h : List T, p <+: h → (h.map f).sum ≤ q → (p.map f).sum ≤ q := by rintro p h ⟨e, rfl⟩ hh simp only [List.map_append, List.sum_append] at hh @@ -48,7 +48,7 @@ theorem cost_prefix_closed {T : Type} (f : T → ℕ) (q : ℕ) : /-- An exact domain intersected with a budget of `k` inputs is again silent before the first input and closed under nonempty prefixes. -/ -theorem budget_nonempty_prefix {A : Type} {P : List A → Prop} {k : ℕ} +lemma budget_nonempty_prefix {A : Type} {P : List A → Prop} {k : ℕ} (hP : ¬ P [] ∧ ∀ {p h}, p <+: h → p ≠ [] → P h → P p) : ¬ (P [] ∧ ([] : List A).length ≤ k) ∧ ∀ {p h : List A}, p <+: h → p ≠ [] → P h ∧ h.length ≤ k → P p ∧ p.length ≤ k := @@ -73,18 +73,18 @@ noncomputable def callProg (j : J) (x : X j) | [] => .inr ⟨j, x⟩ | (_, ⟨j', y⟩) :: h => if hj : j' = j then k (hj ▸ y) h else .inr ⟨j, x⟩ -theorem callBound_return (b : ℕ) (a : A) : +lemma callBound_return (b : ℕ) (a : A) : CallBound (X := X) (Y := Y) b (returnProg a) := by intro h q _ hq cases hq -theorem _root_.SystemAlgebra.Program.CallBound.mono {a b : ℕ} {f : List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)} +lemma _root_.SystemAlgebra.Program.CallBound.mono {a b : ℕ} {f : List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)} (hf : CallBound a f) (hab : a ≤ b) : CallBound b f := fun h q hc hq => (hf h q hc hq).trans_le hab /-- The exchanges of a call statement: its query, answered at its label, then the exchanges of its continuation. -/ -theorem exchangesOf_callProg {j : J} {x : X j} +lemma exchangesOf_callProg {j : J} {x : X j} {k : Y j → List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)} {z : (Σ j, X j) × (Σ j, Y j)} {h : List ((Σ j, X j) × (Σ j, Y j))} (hc : ExchangesOf (callProg j x k) (z :: h)) : @@ -99,7 +99,7 @@ theorem exchangesOf_callProg {j : J} {x : X j} obtain ⟨hq', hl'⟩ := hc (i + 1) (by simpa using hi) simpa [callProg] using And.intro hq' hl' -theorem callBound_call {b : ℕ} (j : J) (x : X j) +lemma callBound_call {b : ℕ} (j : J) (x : X j) (k : Y j → List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)) (hk : ∀ y, CallBound b (k y)) : CallBound (b + 1) (callProg j x k) := by intro h q hc hq @@ -110,7 +110,7 @@ theorem callBound_call {b : ℕ} (j : J) (x : X j) simpa using hk y h q hc' hq /-- Either branch uses at most the larger of their bounds. -/ -theorem callBound_ite (p : Prop) [Decidable p] {a b : ℕ} +lemma callBound_ite (p : Prop) [Decidable p] {a b : ℕ} {f g : List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)} (hf : CallBound a f) (hg : CallBound b g) : CallBound (max a b) (if p then f else g) := by @@ -119,7 +119,7 @@ theorem callBound_ite (p : Prop) [Decidable p] {a b : ℕ} · exact hg.mono (le_max_right _ _) /-- A loop costs its final continuation plus a fixed bound per element. -/ -theorem callBound_foldr {T C : Type} (xs : List T) +lemma callBound_foldr {T C : Type} (xs : List T) (step : T → (C → List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)) → C → List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)) (finish : C → List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)) @@ -133,7 +133,7 @@ theorem callBound_foldr {T C : Type} (xs : List T) hb x (a + xs.length * b) (xs.foldr step finish) ih c /-- Finite inputs and private bindings turn per-invocation bounds into one uniform bound. -/ -theorem callBound_uniform {S O : Type} {U V : O → Type} +lemma callBound_uniform {S O : Type} {U V : O → Type} [_root_.Finite S] [_root_.Finite O] [∀ o, _root_.Finite (U o)] (body : Program S O J U V X Y) (hb : ∀ s o u, ∃ b, CallBound b (body s o u)) : ∃ b, body.Bounded b := by @@ -142,17 +142,17 @@ theorem callBound_uniform {S O : Type} {U V : O → Type} (fun p : S × (Σ o, U o) => cost p.1 p.2.1 p.2.2) exact ⟨b, fun s o u => (hcost s o u).mono (hbound (s, ⟨o, u⟩))⟩ -theorem _root_.SystemAlgebra.Program.CallCost.of_eq {m n : ℕ} {f : List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)} +lemma _root_.SystemAlgebra.Program.CallCost.of_eq {m n : ℕ} {f : List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)} (e : m = n) (hf : CallCost m f) : CallCost n f := e ▸ hf -theorem callCost_return (a : A) : CallCost (X := X) (Y := Y) 0 (returnProg a) := by +lemma callCost_return (a : A) : CallCost (X := X) (Y := Y) 0 (returnProg a) := by intro h hc refine ⟨fun q hq => by simp [returnProg] at hq, fun a' _ => ?_⟩ rcases h with _ | ⟨z, h⟩ · rfl · exact absurd (hc 0 (by simp)).1 (by simp [returnProg]) -theorem callCost_call {n : ℕ} (j : J) (x : X j) +lemma callCost_call {n : ℕ} (j : J) (x : X j) (k : Y j → List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)) (hk : ∀ y, CallCost n (k y)) : CallCost (n + 1) (callProg j x k) := by intro h hc @@ -164,7 +164,7 @@ theorem callCost_call {n : ℕ} (j : J) (x : X j) fun a ha => by rw [he] at ha; simpa using h₂ a ha⟩ /-- A loop spends a fixed cost per element on top of its final continuation. -/ -theorem callCost_foldr {T C : Type} (xs : List T) +lemma callCost_foldr {T C : Type} (xs : List T) (step : T → (C → List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)) → C → List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)) (finish : C → List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)) @@ -185,11 +185,11 @@ variable {O : Type} (ι : O → Option J) def Avoids (f : List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)) : Prop := ∀ h q, ExchangesOf f h → f h = .inr q → ∀ o, ι o ≠ some q.1 -theorem avoids_return (a : A) : Avoids (X := X) (Y := Y) ι (returnProg a) := by +lemma avoids_return (a : A) : Avoids (X := X) (Y := Y) ι (returnProg a) := by intro h q _ hq cases hq -theorem avoids_call {j : J} (x : X j) +lemma avoids_call {j : J} (x : X j) (k : Y j → List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)) (hk : ∀ y, Avoids ι (k y)) (hj : ∀ o, ι o ≠ some j) : Avoids ι (callProg j x k) := by intro h q hc hq @@ -200,14 +200,14 @@ theorem avoids_call {j : J} (x : X j) rw [he] at hq exact hk y h q hc' hq -theorem preservesAt_return (o : O) (a : A) : +lemma preservesAt_return (o : O) (a : A) : PreservesAt (X := X) (Y := Y) ι o (returnProg a) := by intro h q _ hq cases hq /-- A call at a label `ι` names at most for `o`, after which the body makes no query at the labels `ι o'`. -/ -theorem preservesAt_call_self {o : O} {j : J} (x : X j) +lemma preservesAt_call_self {o : O} {j : J} (x : X j) (k : Y j → List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)) (hk : ∀ y, Avoids ι (k y)) (hι : ∀ o', ι o' = some j → o' = o) : PreservesAt ι o (callProg j x k) := by @@ -220,7 +220,7 @@ theorem preservesAt_call_self {o : O} {j : J} (x : X j) exact absurd hq' (hk y h q hc' hq o') /-- A call at a label no `ι o'` names. -/ -theorem preservesAt_call_other {o : O} {j : J} (x : X j) +lemma preservesAt_call_other {o : O} {j : J} (x : X j) (k : Y j → List ((Σ j, X j) × (Σ j, Y j)) → A ⊕ (Σ j, X j)) (hk : ∀ y, PreservesAt ι o (k y)) (hj : ∀ o', ι o' ≠ some j) : PreservesAt ι o (callProg j x k) := by diff --git a/src/ConstructiveCryptography/Functional.lean b/src/ConstructiveCryptography/Functional.lean index e5c4c0f..e6a2c05 100644 --- a/src/ConstructiveCryptography/Functional.lean +++ b/src/ConstructiveCryptography/Functional.lean @@ -56,7 +56,7 @@ noncomputable def ofConditional noncomputable def ofFunction (f : ∀ i, A.X i → A.Y i) : Resource A := ofConditional fun _ i x _ => ⟨Finsupp.single (f i x) 1, Distribution.isProbDist_single _⟩ -theorem ofFunction_snoc (f : ∀ i, A.X i → A.Y i) +lemma ofFunction_snoc (f : ∀ i, A.X i → A.Y i) (h : List ((Σ i, A.X i) × (Σ i, A.Y i))) (x : Σ i, A.X i) (y : Σ i, A.Y i) : (ofFunction f).1 (h ++ [(x, y)]) = if A.domain (h.map Prod.fst ++ [x]) then @@ -71,7 +71,7 @@ theorem ofFunction_snoc (f : ∀ i, A.X i → A.Y i) /-- A functional resource gives probability one to its prescribed answers on each admitted history. -/ -theorem ofFunction_mass_eq_one (f : ∀ i, A.X i → A.Y i) +lemma ofFunction_mass_eq_one (f : ∀ i, A.X i → A.Y i) (h : List ((Σ i, A.X i) × (Σ i, A.Y i))) (hd : h = [] ∨ A.domain (h.map Prod.fst)) (he : ∀ z ∈ h, z.2 = ⟨z.1.1, f z.1.1 z.1.2⟩) : @@ -90,7 +90,7 @@ theorem ofFunction_mass_eq_one (f : ∀ i, A.X i → A.Y i) rw [ofFunction_snoc, if_pos hp, if_pos (he z (by simp)), ih hh (fun w hw => he w (List.mem_append_left _ hw)), mul_one] -theorem ofFunction_answers (f : ∀ i, A.X i → A.Y i) +lemma ofFunction_answers (f : ∀ i, A.X i → A.Y i) (h : List ((Σ i, A.X i) × (Σ i, A.Y i))) (hm : (ofFunction f).1 h ≠ 0) : ∀ z ∈ h, z.2 = ⟨z.1.1, f z.1.1 z.1.2⟩ := by induction h using List.reverseRecOn with @@ -107,7 +107,7 @@ theorem ofFunction_answers (f : ∀ i, A.X i → A.Y i) /-- The cumulative law of a function is the indicator of its admitted query/reply histories. -/ -theorem ofFunction_mass (f : ∀ i, A.X i → A.Y i) +lemma ofFunction_mass (f : ∀ i, A.X i → A.Y i) (h : List ((Σ i, A.X i) × (Σ i, A.Y i))) : (ofFunction f).1 h = if (h = [] ∨ A.domain (h.map Prod.fst)) ∧ @@ -125,7 +125,7 @@ theorem ofFunction_mass (f : ∀ i, A.X i → A.Y i) /-- Probability one on the functional transcripts determines the entire behavior, including probability zero for every different answer. -/ -theorem eq_ofFunction (R : Resource A) (f : ∀ i, A.X i → A.Y i) +lemma eq_ofFunction (R : Resource A) (f : ∀ i, A.X i → A.Y i) (certain : ∀ h, (h = [] ∨ A.domain (h.map Prod.fst)) → (∀ z ∈ h, z.2 = ⟨z.1.1, f z.1.1 z.1.2⟩) → R.1 h = 1) : R = ofFunction f := by @@ -180,12 +180,12 @@ noncomputable def sample {K : Type} (P : Distribution K) [Distribution.IsProbabi rw [RandomSystem.mix_mass] exact Finset.sum_eq_zero fun k _ => by rw [(R k).2 h x y hne, mul_zero]⟩ -theorem sample_mass {K : Type} (P : Distribution K) [Distribution.IsProbability P] +lemma sample_mass {K : Type} (P : Distribution K) [Distribution.IsProbability P] (R : K → Resource A) h : (sample P R).1 h = ∑ k ∈ P.support, P k * (R k).1 h := rfl /-- Initial sampling of functions is their existing finite DDS presentation. -/ -theorem sample_ofFunction_mass {K : Type} (P : Distribution K) +lemma sample_ofFunction_mass {K : Type} (P : Distribution K) [Distribution.IsProbability P] (f : K → ∀ i, A.X i → A.Y i) (h : List ((Σ i, A.X i) × (Σ i, A.Y i))) : (sample P (fun k => ofFunction (f k))).1 h = diff --git a/src/ConstructiveCryptography/Interface.lean b/src/ConstructiveCryptography/Interface.lean index b3ff303..4140cd4 100644 --- a/src/ConstructiveCryptography/Interface.lean +++ b/src/ConstructiveCryptography/Interface.lean @@ -101,7 +101,7 @@ noncomputable def Resource.ofPDS {A : Interface} RandomSystem.ofPDS_repliesAtQueriedInterface P⟩ /-- Every resource is the behavior of a PDS of deterministic resources. -/ -theorem Resource.exists_ofPDS {A : Interface} (R : Resource A) : +lemma Resource.exists_ofPDS {A : Interface} (R : Resource A) : ∃ Q : Probability.Distribution.ProbDist {s : InterfaceSystem A.I A.X A.Y // IsDDS s ∧ SystemAlgebra.RepliesAtQueriedInterface s ∧ ∀ h, (s h).Dom ↔ A.domain h}, Resource.ofPDS Q = R := by @@ -115,7 +115,7 @@ noncomputable def ofDeterministic {A : Interface} (s : InterfaceSystem A.I A.X A Resource.ofPDS ⟨Finsupp.single ⟨s, hs⟩ 1, Probability.Distribution.isProbDist_single _⟩ open Classical in -theorem ofDeterministic_mass {A : Interface} (s : InterfaceSystem A.I A.X A.Y) +lemma ofDeterministic_mass {A : Interface} (s : InterfaceSystem A.I A.X A.Y) (hs : IsDDS s ∧ SystemAlgebra.RepliesAtQueriedInterface s ∧ ∀ h, (s h).Dom ↔ A.domain h) (h : List ((Σ i, A.X i) × (Σ i, A.Y i))) : (ofDeterministic s hs).1 h = @@ -143,7 +143,7 @@ noncomputable def ofDDC {A B : Interface} (α : InsideOutsideSystem A.I B.I A.X PDCBehavior.ofDDC α hα /-- The converter of a DDC gives probability one to its transcripts and zero to all others. -/ -theorem ofDDC_apply {A B : Interface} (α : InsideOutsideSystem A.I B.I A.X A.Y B.X B.Y) +lemma ofDDC_apply {A B : Interface} (α : InsideOutsideSystem A.I B.I A.X A.Y B.X B.Y) {b : ℕ} (hα : IsDDCFrom B.domain A.domain b α) (t : List ((Σ l, twoFam A.X B.Y l) × (Σ l, twoFam A.Y B.X l))) : (ofDDC α hα).1 t = open Classical in @@ -161,11 +161,11 @@ whose domains are still to be inferred takes them from the resource it acts on. noncomputable instance {A B : Interface} : HSMul (A ⟶ B) (Resource B) (Resource A) := ⟨attach⟩ -theorem smul_val {A B : Interface} (α : A ⟶ B) (R : Resource B) : +lemma smul_val {A B : Interface} (α : A ⟶ B) (R : Resource B) : (α • R).1 = PDCBehavior.attach B.nonempty_prefix A.nonempty_prefix α R.1 R.2 := rfl /-- **Attaching the identity** leaves a resource unchanged. -/ -theorem identity_attach {A : Interface} (R : Resource A) : (𝟙 A • R : Resource A) = R := +lemma identity_attach {A : Interface} (R : Resource A) : (𝟙 A • R : Resource A) = R := Subtype.ext (PDCBehavior.attach_id A.nonempty_prefix R.1 R.2) /-- **Serial attachment** (MR16 §3.3, printed p. 7: “(β ∘ α)ⁱR = βⁱ(αⁱR)”): attaching a @@ -175,7 +175,7 @@ theorem comp_smul {A B C : Interface} (α : A ⟶ B) (β : B ⟶ C) (R : Resourc Subtype.ext (PDCBehavior.attach_comp C.nonempty_prefix A.nonempty_prefix B.nonempty_prefix α β R.1 R.2) -theorem comp_eq {A B C : Interface} (α : A ⟶ B) (β : B ⟶ C) : +lemma comp_eq {A B C : Interface} (α : A ⟶ B) (β : B ⟶ C) : α ≫ β = PDCBehavior.comp α β := rfl end Interface diff --git a/src/ConstructiveCryptography/InterfaceAlgebra.lean b/src/ConstructiveCryptography/InterfaceAlgebra.lean index 706af8e..481777e 100644 --- a/src/ConstructiveCryptography/InterfaceAlgebra.lean +++ b/src/ConstructiveCryptography/InterfaceAlgebra.lean @@ -114,18 +114,18 @@ noncomputable def absorb {A B : Interface} (α : A ⟶ B) (D : A.inputDomain.Dis /-- **Absorbing a serial composition** absorbs its converters in turn: `D ∘ (α ≫ β) = (D ∘ α) ∘ β`. -/ -theorem absorb_comp {A B C : Interface} (α : A ⟶ B) (β : B ⟶ C) +lemma absorb_comp {A B C : Interface} (α : A ⟶ B) (β : B ⟶ C) (D : A.inputDomain.DistinguisherBehavior) : absorb (α ≫ β) D = absorb β (absorb α D) := D.absorb_comp C.nonempty_prefix A.nonempty_prefix B.nonempty_prefix α β /-- Absorbing a converter into a distinguisher gives a distinguisher. -/ -theorem distinguishers_attach {A B : Interface} (α : A ⟶ B) {d : Resource A → ℝ} +lemma distinguishers_attach {A B : Interface} (α : A ⟶ B) {d : Resource A → ℝ} (hd : d ∈ distinguishers A) : (fun R : Resource B => d (α • R)) ∈ distinguishers B := by obtain ⟨D, rfl⟩ := hd exact ⟨absorb α D, rfl⟩ /-- Running a fixed resource beside the distinguished one gives a distinguisher. -/ -theorem distinguishers_parallel_left {A B : Interface} (T : Resource B) +lemma distinguishers_parallel_left {A B : Interface} (T : Resource B) {d : Resource (tensor A B) → ℝ} (hd : d ∈ distinguishers (tensor A B)) : (fun R : Resource A => d (parallel R T)) ∈ distinguishers A := by obtain ⟨D, rfl⟩ := hd @@ -140,7 +140,7 @@ theorem distinguishers_parallel_left {A B : Interface} (T : Resource B) rw [parallel_ofPDS] exact (hQ Pr _ _ (fun _ => rfl) (fun _ => rfl)).symm -theorem distinguishers_parallel_right {A B : Interface} (T : Resource A) +lemma distinguishers_parallel_right {A B : Interface} (T : Resource A) {d : Resource (tensor A B) → ℝ} (hd : d ∈ distinguishers (tensor A B)) : (fun S : Resource B => d (parallel T S)) ∈ distinguishers B := by have h := distinguishers_parallel_left T (distinguishers_attach (swap A B).hom hd) @@ -155,15 +155,15 @@ noncomputable instance compatibleDistinguisherClass : (fun T _ hd => distinguishers_parallel_left T hd) (fun T _ hd => distinguishers_parallel_right T hd) -theorem cc_parallel_eq {A B : Interface} (R : Resource A) (S : Resource B) : +lemma cc_parallel_eq {A B : Interface} (R : Resource A) (S : Resource B) : ConstructiveCryptography.CryptographicAlgebra.parallel R S = parallel R S := rfl -theorem cc_dummy_eq : +lemma cc_dummy_eq : ConstructiveCryptography.CryptographicAlgebra.dummy = dummy := rfl /-- The distance of two resources is the transcript distance of their random systems. -/ -theorem cc_distance_eq {A : Interface} (R S : Resource A) : +lemma cc_distance_eq {A : Interface} (R S : Resource A) : ConstructiveCryptography.CryptographicAlgebra.distance R S = R.1.transcriptDistance S.1 := by rw [RandomSystem.transcriptDistance_eq_iSup_behavior R S] @@ -187,7 +187,7 @@ noncomputable def distinguisherAdvantage /-- The advantage of a distinguisher between two attachments is the advantage of the distinguisher with the converter absorbed. -/ -theorem distinguisherAdvantage_attach +lemma distinguisherAdvantage_attach (admissible : ∀ A : Interface, Set A.inputDomain.DistinguisherBehavior) {A B : Interface} (α : A ⟶ B) (D : A.inputDomain.DistinguisherBehavior) (R S : Resource B) : (distinguisherAdvantage admissible).advantage A D (α • R) (α • S) = @@ -197,7 +197,7 @@ theorem distinguisherAdvantage_attach /-- **A concrete substitution through a converter**: its loss is the loss at the distinguisher with the converter absorbed (Banfi 2023, §2.3.3, printed p. 16: `ε'(D) := ε(D ∘ ρ)`), when the admitted distinguishers are closed under absorbing converters. -/ -theorem substitutesWithin_attach +lemma substitutesWithin_attach (admissible : ∀ A : Interface, Set A.inputDomain.DistinguisherBehavior) (closed : ∀ {A B : Interface} (α : A ⟶ B) (D : A.inputDomain.DistinguisherBehavior), D ∈ admissible A → absorb α D ∈ admissible B) @@ -220,7 +220,7 @@ class AdmissibleDistinguishers where /-- **A substitution through a converter**, for the admitted distinguishers: its loss is the loss at the distinguisher with the converter absorbed. -/ -theorem AdmissibleDistinguishers.substitutesWithin_attach [AdmissibleDistinguishers] +lemma AdmissibleDistinguishers.substitutesWithin_attach [AdmissibleDistinguishers] {A B : Interface} (α : A ⟶ B) {error : B.inputDomain.DistinguisherBehavior → ENNReal} {R S : Resource B} (h : (distinguisherAdvantage AdmissibleDistinguishers.admissible).SubstitutesWithin error R S) : @@ -232,7 +232,7 @@ theorem AdmissibleDistinguishers.substitutesWithin_attach [AdmissibleDistinguish `S` for `R` inside the context `ρ` loses the error at the distinguisher with `ρ` absorbed. The context may be a serial composition; its attachments `X` and `Y` are written converter by converter. -/ -theorem AdmissibleDistinguishers.substitutesWithin_context [AdmissibleDistinguishers] +lemma AdmissibleDistinguishers.substitutesWithin_context [AdmissibleDistinguishers] {A B : Interface} (ρ : A ⟶ B) {error : B.inputDomain.DistinguisherBehavior → ENNReal} {R S : Resource B} (h : (distinguisherAdvantage AdmissibleDistinguishers.admissible).SubstitutesWithin error R S) @@ -245,7 +245,7 @@ theorem AdmissibleDistinguishers.substitutesWithin_context [AdmissibleDistinguis exact AdmissibleDistinguishers.substitutesWithin_attach ρ h /-- The advantage of a distinguisher is at most the distance. -/ -theorem distinguisherAdvantage_le_distance +lemma distinguisherAdvantage_le_distance (admissible : ∀ A : Interface, Set A.inputDomain.DistinguisherBehavior) {A : Interface} (D : A.inputDomain.DistinguisherBehavior) (R S : Resource A) : (distinguisherAdvantage admissible).advantage A D R S ≤ diff --git a/src/ConstructiveCryptography/InterfaceCoherence.lean b/src/ConstructiveCryptography/InterfaceCoherence.lean index a9afe6e..da364b1 100644 --- a/src/ConstructiveCryptography/InterfaceCoherence.lean +++ b/src/ConstructiveCryptography/InterfaceCoherence.lean @@ -36,12 +36,12 @@ def assocAlphabet {I J K : Type} (F : I → Type) (G : J → Type) (H : K → Ty left_inv := by rintro ⟨((i | j) | k), x⟩ <;> rfl right_inv := by rintro ⟨(i | j | k), x⟩ <;> rfl -theorem assocAlphabet_fst {I J K : Type} (F : I → Type) (G : J → Type) (H : K → Type) +lemma assocAlphabet_fst {I J K : Type} (F : I → Type) (G : J → Type) (H : K → Type) (x : Σ l, Sum.rec (Sum.rec F G) H l) : (assocAlphabet F G H x).1 = Equiv.sumAssoc I J K x.1 := by rcases x with ⟨((i | j) | k), x⟩ <;> rfl -theorem empty_or_parallelDomain (A B : Interface) +lemma empty_or_parallelDomain (A B : Interface) (h : List (Σ l, Sum.rec A.X B.X l)) : (h = [] ∨ parallelDomain A B h) ↔ (restrict none (h.map (sumAlphabet (Sum.rec A.X B.X)).symm) = [] ∨ @@ -52,7 +52,7 @@ theorem empty_or_parallelDomain (A B : Interface) · simp only [hn, List.map_nil, restrict_nil, true_or, true_and] · simp only [parallelDomain, parallelInputs, ne_eq, hn, not_false_eq_true, true_and, false_or] -theorem parallelDomain_assoc (A B C : Interface) +lemma parallelDomain_assoc (A B C : Interface) (h : List (Σ l, Sum.rec (Sum.rec A.X B.X) C.X l)) : parallelDomain A (tensor B C) (h.map (assocAlphabet A.X B.X C.X)) ↔ parallelDomain (tensor A B) C h := by @@ -106,7 +106,7 @@ def leftUnitAlphabet {I : Type} (F : I → Type) : left_inv := by rintro ⟨(e | i), x⟩; exact e.elim; rfl right_inv := by rintro ⟨i, x⟩; rfl -theorem leftUnitAlphabet_fst {I : Type} (F : I → Type) +lemma leftUnitAlphabet_fst {I : Type} (F : I → Type) (x : Σ l, Sum.rec (fun e : Empty => Empty.elim e) F l) : (leftUnitAlphabet F x).1 = Equiv.emptySum Empty I x.1 := by rcases x with ⟨(e | i), x⟩ @@ -122,14 +122,14 @@ def rightUnitAlphabet {I : Type} (F : I → Type) : left_inv := by rintro ⟨(i | e), x⟩; rfl; exact e.elim right_inv := by rintro ⟨i, x⟩; rfl -theorem rightUnitAlphabet_fst {I : Type} (F : I → Type) +lemma rightUnitAlphabet_fst {I : Type} (F : I → Type) (x : Σ l, Sum.rec F (fun e : Empty => Empty.elim e) l) : (rightUnitAlphabet F x).1 = Equiv.sumEmpty I Empty x.1 := by rcases x with ⟨(i | e), x⟩ · rfl · exact e.elim -theorem parallelDomain_unit_left (A : Interface) +lemma parallelDomain_unit_left (A : Interface) (h : List (Σ l, Sum.rec unit.X A.X l)) : A.domain (h.map (leftUnitAlphabet A.X)) ↔ parallelDomain unit A h := by change A.domain (h.map (leftUnitAlphabet A.X)) ↔ @@ -158,7 +158,7 @@ theorem parallelDomain_unit_left (A : Interface) · rintro ⟨hn, hd⟩ exact hd.resolve_left hn -theorem parallelDomain_unit_right (A : Interface) +lemma parallelDomain_unit_right (A : Interface) (h : List (Σ l, Sum.rec A.X unit.X l)) : A.domain (h.map (rightUnitAlphabet A.X)) ↔ parallelDomain A unit h := by dsimp only [unit] at h diff --git a/src/ConstructiveCryptography/InterfaceFilter.lean b/src/ConstructiveCryptography/InterfaceFilter.lean index 60e3b20..b4ed784 100644 --- a/src/ConstructiveCryptography/InterfaceFilter.lean +++ b/src/ConstructiveCryptography/InterfaceFilter.lean @@ -51,7 +51,7 @@ open Classical Probability CategoryTheory /-- **A filter attached to a resource** is the restriction of the resource's random system to the restricted domain. -/ -theorem filter_smul (A : Interface) (D : List (Σ i, A.X i) → Prop) +lemma filter_smul (A : Interface) (D : List (Σ i, A.X i) → Prop) (hD : ∀ p h, p <+: h → D h → D p) (R : Resource A) : (filter A D hD • R).1 = R.1.restrict (A.restrict D hD).inputDomain fun _ _ hx => hx.1 := by obtain ⟨Q, hQ⟩ := Resource.exists_ofPDS R @@ -85,7 +85,7 @@ theorem filter_smul (A : Interface) (D : List (Σ i, A.X i) → Prop) /-- **Two filters in series** act as the filter of both conditions: the resources have the same transcript masses. -/ -theorem filter_comp_filter_smul (A : Interface) (D : List (Σ i, A.X i) → Prop) +lemma filter_comp_filter_smul (A : Interface) (D : List (Σ i, A.X i) → Prop) (hD : ∀ p h, p <+: h → D h → D p) (D' : List (Σ i, A.X i) → Prop) (hD' : ∀ p h, p <+: h → D' h → D' p) (R : Resource A) : ((filter (A.restrict D hD) D' hD' ≫ filter A D hD) • R).1.1 = diff --git a/src/ConstructiveCryptography/InterfaceGame.lean b/src/ConstructiveCryptography/InterfaceGame.lean index a949d72..997de07 100644 --- a/src/ConstructiveCryptography/InterfaceGame.lean +++ b/src/ConstructiveCryptography/InterfaceGame.lean @@ -192,7 +192,7 @@ noncomputable instance distinctionGames : DistinctionGames Interface Resource Ga /-- **Winning by every distinguisher bounds winning by every winner**: a bound on the winning probability of every distinguisher for the game's system bounds the winning probability of every winner. -/ -theorem win_le {A : Interface} {G : Game A} {ε : ℝ} +lemma win_le {A : Interface} {G : Game A} {ε : ℝ} (hW : ∀ P : A.inputDomain.Distinguisher, P.winProbability G.1.1 ≤ ε) {winner : Game A → ℝ} (hw : winner ∈ Games.winners A) : winner G ≤ ε := by -- The winner is the winning probability of a solver behavior `s`, which is that of one diff --git a/src/ConstructiveCryptography/InterfaceMonoidal.lean b/src/ConstructiveCryptography/InterfaceMonoidal.lean index dc685ca..ee5217c 100644 --- a/src/ConstructiveCryptography/InterfaceMonoidal.lean +++ b/src/ConstructiveCryptography/InterfaceMonoidal.lean @@ -27,31 +27,31 @@ noncomputable instance monoidalStruct : MonoidalCategoryStruct Interface where leftUnitor := leftUnitor rightUnitor := rightUnitor -theorem tensorHom_eq {A B C D : Interface} (α : A ⟶ B) (β : C ⟶ D) : +lemma tensorHom_eq {A B C D : Interface} (α : A ⟶ B) (β : C ⟶ D) : α ⊗ₘ β = parallelConverter α β := rfl -theorem id_tensor_id (A B : Interface) : (𝟙 A ⊗ₘ 𝟙 B : A ⊗ B ⟶ A ⊗ B) = 𝟙 (A ⊗ B) := +lemma id_tensor_id (A B : Interface) : (𝟙 A ⊗ₘ 𝟙 B : A ⊗ B ⟶ A ⊗ B) = 𝟙 (A ⊗ B) := PDCBehavior.tensor_id A.nonempty_prefix B.nonempty_prefix -theorem tensor_comp {A B C D E F : Interface} +lemma tensor_comp {A B C D E F : Interface} (α : A ⟶ B) (β : C ⟶ D) (γ : B ⟶ E) (δ : D ⟶ F) : (α ⊗ₘ β) ≫ (γ ⊗ₘ δ) = (α ≫ γ) ⊗ₘ (β ≫ δ) := PDCBehavior.comp_tensor α β γ δ -theorem associator_naturality {A B C D E F : Interface} +lemma associator_naturality {A B C D E F : Interface} (α : A ⟶ D) (β : B ⟶ E) (γ : C ⟶ F) : ((α ⊗ₘ β) ⊗ₘ γ) ≫ (α_ D E F).hom = (α_ A B C).hom ≫ (α ⊗ₘ (β ⊗ₘ γ)) := comp_associator α β γ -theorem leftUnitor_naturality {A B : Interface} (α : A ⟶ B) : +lemma leftUnitor_naturality {A B : Interface} (α : A ⟶ B) : (𝟙 (𝟙_ Interface) ⊗ₘ α) ≫ (λ_ B).hom = (λ_ A).hom ≫ α := comp_leftUnitor α -theorem rightUnitor_naturality {A B : Interface} (α : A ⟶ B) : +lemma rightUnitor_naturality {A B : Interface} (α : A ⟶ B) : (α ⊗ₘ 𝟙 (𝟙_ Interface)) ≫ (ρ_ B).hom = (ρ_ A).hom ≫ α := comp_rightUnitor α -theorem pentagon (A B C D : Interface) : +lemma pentagon (A B C D : Interface) : ((α_ A B C).hom ⊗ₘ 𝟙 D) ≫ (α_ A (B ⊗ C) D).hom ≫ (𝟙 A ⊗ₘ (α_ B C D).hom) = (α_ (A ⊗ B) C D).hom ≫ (α_ A B (C ⊗ D)).hom := by change parallelConverter (associator A B C).hom (𝟙 D) ≫ @@ -75,7 +75,7 @@ theorem pentagon (A B C D : Interface) : intro y rcases y with ⟨(((a | b) | c) | d), y⟩ <;> rfl -theorem triangle (A B : Interface) : +lemma triangle (A B : Interface) : (α_ A (𝟙_ Interface) B).hom ≫ (𝟙 A ⊗ₘ (λ_ B).hom) = (ρ_ A).hom ⊗ₘ 𝟙 B := by change (associator A unit B).hom ≫ parallelConverter (𝟙 A) (leftUnitor B).hom = parallelConverter (rightUnitor A).hom (𝟙 B) diff --git a/src/ConstructiveCryptography/InterfaceParallel.lean b/src/ConstructiveCryptography/InterfaceParallel.lean index 1354bb4..5d1950a 100644 --- a/src/ConstructiveCryptography/InterfaceParallel.lean +++ b/src/ConstructiveCryptography/InterfaceParallel.lean @@ -62,7 +62,7 @@ def swapAlphabet {I J : Type} (F : I → Type) (G : J → Type) : abbrev parallelDomain (A B : Interface) : List (Σ l, Sum.rec A.X B.X l) → Prop := parallelInputs (F := Sum.rec A.X B.X) A.domain B.domain -theorem parallelDomain_swap (A B : Interface) (h : List (Σ l, Sum.rec A.X B.X l)) : +lemma parallelDomain_swap (A B : Interface) (h : List (Σ l, Sum.rec A.X B.X l)) : parallelDomain B A (h.map (swapAlphabet A.X B.X)) ↔ parallelDomain A B h := by have hp : restrict none ((h.map (swapAlphabet A.X B.X)).map (sumAlphabet (Sum.rec B.X A.X)).symm) = @@ -91,7 +91,7 @@ abbrev tensor (A B : Interface) : Interface where bound := A.bound + B.bound length_le := parallelInputs_length_le A.length_le B.length_le -theorem Resource.possible_domain {A : Interface} (R : Resource A) +lemma Resource.possible_domain {A : Interface} (R : Resource A) {h : List ((Σ i, A.X i) × (Σ i, A.Y i))} (hp : R.1 h ≠ 0) : h.map Prod.fst = [] ∨ A.domain (h.map Prod.fst) := by rcases List.eq_nil_or_concat h with rfl | ⟨h, ⟨x, y⟩, rfl⟩ @@ -101,7 +101,7 @@ theorem Resource.possible_domain {A : Interface} (R : Resource A) by_contra hd exact hp (R.1.mass_eq_zero_of_not_admitted hd y) -theorem parallel_admits_iff (A B : Interface) (R : Resource A) (S : Resource B) +lemma parallel_admits_iff (A B : Interface) (R : Resource A) (S : Resource B) (h : List (Two (Σ i, A.X i) (Σ j, B.X j) × Two (Σ i, A.Y i) (Σ j, B.Y j))) (hp : RandomSystem.parallel R.1 S.1 h ≠ 0) (x : Two (Σ i, A.X i) (Σ j, B.X j)) : @@ -192,7 +192,7 @@ noncomputable def parallel {A B : Interface} (R : Resource A) (S : Resource B) : List.append_nil] using mul_eq_zero.mpr (Or.inr hs) · rfl -theorem parallel_mass {A B : Interface} (R : Resource A) (S : Resource B) +lemma parallel_mass {A B : Interface} (R : Resource A) (S : Resource B) (h : List ((Σ i, (tensor A B).X i) × (Σ i, (tensor A B).Y i))) : (parallel R S).1 h = RandomSystem.parallel R.1 S.1 (h.map ((sumAlphabet (Sum.rec A.X B.X)).symm.prodCongr diff --git a/src/ConstructiveCryptography/InterfaceRelabel.lean b/src/ConstructiveCryptography/InterfaceRelabel.lean index 36b9ed1..ef946c9 100644 --- a/src/ConstructiveCryptography/InterfaceRelabel.lean +++ b/src/ConstructiveCryptography/InterfaceRelabel.lean @@ -13,7 +13,7 @@ namespace SystemAlgebra.Interface open Classical CategoryTheory -theorem alphabet_symm_label {I J : Type} {X : I → Type} {Y : J → Type} +lemma alphabet_symm_label {I J : Type} {X : I → Type} {Y : J → Type} (e : I ≃ J) (f : (Σ i, X i) ≃ (Σ j, Y j)) (hf : ∀ x, (f x).1 = e x.1) (y : Σ j, Y j) : (f.symm y).1 = e.symm y.1 := by @@ -32,13 +32,13 @@ noncomputable def rename {A B : Interface} (e : A.I ≃ B.I) (alphabet_symm_label e g hg) hd) /-- The identity filter lies below the forwarding converter. -/ -theorem filter_mem {A : Interface} {h y} +lemma filter_mem {A : Interface} {h y} (hy : y ∈ (DDC.filter (Y := A.Y) (fun h => h = [] ∨ A.domain h) (prefix_or_nil A.nonempty_prefix.2)).1 h) : y ∈ idConverter A.I A.X A.Y h := ((filterDom_mem_iff _ _ h y).mp hy).2 /-- A renaming is the behavior of a DDC below the renaming converter. -/ -theorem exists_rename_eq_ofDDC {A B : Interface} (e : A.I ≃ B.I) +lemma exists_rename_eq_ofDDC {A B : Interface} (e : A.I ≃ B.I) (f : (Σ i, A.X i) ≃ (Σ j, B.X j)) (g : (Σ i, A.Y i) ≃ (Σ j, B.Y j)) (hf : ∀ x, (f x).1 = e x.1) (hg : ∀ y, (g y).1 = e y.1) (hd : ∀ h, B.domain (h.map f) ↔ A.domain h) : @@ -47,7 +47,7 @@ theorem exists_rename_eq_ofDDC {A B : Interface} (e : A.I ≃ B.I) ∀ h y, y ∈ r h → y ∈ renameConverter f g.symm h := ⟨_, _, rfl, relabel_mono (fun _ _ hy => filter_mem hy) _ _⟩ -theorem rename_refl (A : Interface) : +lemma rename_refl (A : Interface) : rename (Equiv.refl A.I) (Equiv.refl (Σ i, A.X i)) (Equiv.refl (Σ i, A.Y i)) (fun _ => rfl) (fun _ => rfl) (fun h => (congrArg A.domain (List.map_id h)).to_iff) = 𝟙 A := by @@ -60,7 +60,7 @@ theorem rename_refl (A : Interface) : intro xs ys hr rwa [he] at hr -theorem rename_comp {A B C : Interface} +lemma rename_comp {A B C : Interface} (e : A.I ≃ B.I) (f : (Σ i, A.X i) ≃ (Σ j, B.X j)) (g : (Σ i, A.Y i) ≃ (Σ j, B.Y j)) (hf : ∀ x, (f x).1 = e x.1) (hg : ∀ y, (g y).1 = e y.1) (hd : ∀ h, B.domain (h.map f) ↔ A.domain h) diff --git a/src/ConstructiveCryptography/InterfaceTensorRename.lean b/src/ConstructiveCryptography/InterfaceTensorRename.lean index 9457718..ebc9d29 100644 --- a/src/ConstructiveCryptography/InterfaceTensorRename.lean +++ b/src/ConstructiveCryptography/InterfaceTensorRename.lean @@ -43,7 +43,7 @@ def sumEquiv {I J K L : Type} {U : I → Type} {V : J → Type} {X : K → Type} · simpa only [Sigma.eta] using congrArg (fun z : Σ l, Y l => (⟨.inr z.1, z.2⟩ : Σ j, Sum.rec V Y j)) (g.apply_symm_apply ⟨l, x⟩) -theorem sumEquiv_label {A B C D : Interface} (e : A.I ≃ B.I) (e' : C.I ≃ D.I) +lemma sumEquiv_label {A B C D : Interface} (e : A.I ≃ B.I) (e' : C.I ≃ D.I) (f : (Σ i, A.X i) ≃ (Σ j, B.X j)) (f' : (Σ i, C.X i) ≃ (Σ j, D.X j)) (hf : ∀ x, (f x).1 = e x.1) (hf' : ∀ x, (f' x).1 = e' x.1) (x : Σ i, Sum.rec A.X C.X i) : @@ -52,7 +52,7 @@ theorem sumEquiv_label {A B C D : Interface} (e : A.I ≃ B.I) (e' : C.I ≃ D.I · exact congrArg Sum.inl (hf ⟨i, x⟩) · exact congrArg Sum.inr (hf' ⟨j, x⟩) -theorem parallelDomain_sumEquiv {A B C D : Interface} +lemma parallelDomain_sumEquiv {A B C D : Interface} (f : (Σ i, A.X i) ≃ (Σ j, B.X j)) (f' : (Σ i, C.X i) ≃ (Σ j, D.X j)) (hd : ∀ h, B.domain (h.map f) ↔ A.domain h) (hd' : ∀ h, D.domain (h.map f') ↔ C.domain h) @@ -79,7 +79,7 @@ variable {A B C D : Interface} (e' : C.I ≃ D.I) (f' : (Σ i, C.X i) ≃ (Σ j, D.X j)) (g' : (Σ i, C.Y i) ≃ (Σ j, D.Y j)) (hf' : ∀ x, (f' x).1 = e' x.1) (hg' : ∀ y, (g' y).1 = e' y.1) -theorem tensorRaw_rename_forwardAll : +lemma tensorRaw_rename_forwardAll : (tensorRaw (relabel (forwardAll B.I B.X B.Y) (outsideMap f) (outsideMap g.symm)) (relabel (forwardAll D.I D.X D.Y) (outsideMap f') (outsideMap g'.symm)) : InsideOutsideSystem (A.I ⊕ C.I) (B.I ⊕ D.I) (Sum.rec A.X C.X) (Sum.rec A.Y C.Y) @@ -95,7 +95,7 @@ theorem tensorRaw_rename_forwardAll : rcases z with ⟨(_ | ⟨⟨⟩⟩), ⟨⟨(_ | ⟨⟨⟩⟩), i⟩, z⟩⟩ <;> rfl include hf hg hf' hg' in -theorem tensorL_renameConverter : +lemma tensorL_renameConverter : (tensorL (renameConverter f g.symm) (renameConverter f' g'.symm) : InsideOutsideSystem (A.I ⊕ C.I) (B.I ⊕ D.I) (Sum.rec A.X C.X) (Sum.rec A.Y C.Y) (Sum.rec B.X D.X) (Sum.rec B.Y D.Y)) = @@ -125,7 +125,7 @@ namespace SystemAlgebra.Interface open Classical CategoryTheory -theorem parallelConverter_rename {A B C D : Interface} +lemma parallelConverter_rename {A B C D : Interface} (e : A.I ≃ B.I) (f : (Σ i, A.X i) ≃ (Σ j, B.X j)) (g : (Σ i, A.Y i) ≃ (Σ j, B.Y j)) (hf : ∀ x, (f x).1 = e x.1) (hg : ∀ y, (g y).1 = e y.1) (hd : ∀ h, B.domain (h.map f) ↔ A.domain h) diff --git a/src/ConstructiveCryptography/Notation.lean b/src/ConstructiveCryptography/Notation.lean index 364f205..57eea4c 100644 --- a/src/ConstructiveCryptography/Notation.lean +++ b/src/ConstructiveCryptography/Notation.lean @@ -51,7 +51,7 @@ namespace Interface attribute [cc_normalization] comp_smul identity_attach -theorem tensor_smul {A B C D : Interface} (α : A ⟶ B) (β : C ⟶ D) +lemma tensor_smul {A B C D : Interface} (α : A ⟶ B) (β : C ⟶ D) (R : Resource B) (S : Resource D) : (α ⊗ₘ β) • (R ∥ S) = (α • R) ∥ (β • S) := ConstructiveCryptography.CryptographicAlgebra.attach_parallel @@ -71,28 +71,28 @@ simproc [cc_normalization] tensorSmul (@HSMul.hSMul _ _ _ _ _ _) := fun e => do unless ← withDefault (isDefEq e lhs) do return .continue return .visit { expr := rhs, proof? := some (← mkExpectedTypeHint proof (← mkEq e rhs)) } -theorem distance_smul_le {A B : Interface} (α : A ⟶ B) (R S : Resource B) : +lemma distance_smul_le {A B : Interface} (α : A ⟶ B) (R S : Resource B) : Δ (α • R) (α • S) ≤ Δ R S := ConstructiveCryptography.CryptographicAlgebra.distance_attach_le α R S /-- The hybrid inequality, with both endpoints inferred from the goal. -/ -theorem distance_triangle {A : Interface} {R T : Resource A} (S : Resource A) : +lemma distance_triangle {A : Interface} {R T : Resource A} (S : Resource A) : Δ R T ≤ Δ R S + Δ S T := ConstructiveCryptography.CryptographicAlgebra.distance_triangle R S T -theorem distance_parallel_left_le {A B : Interface} +lemma distance_parallel_left_le {A B : Interface} (R S : Resource A) (T : Resource B) : Δ (R ∥ T) (S ∥ T) ≤ Δ R S := ConstructiveCryptography.CryptographicAlgebra.distance_parallel_left_le R S T -theorem distance_parallel_right_le {A B : Interface} +lemma distance_parallel_right_le {A B : Interface} (R : Resource A) (S T : Resource B) : Δ (R ∥ S) (R ∥ T) ≤ Δ S T := ConstructiveCryptography.CryptographicAlgebra.distance_parallel_right_le R S T -theorem distance_parallel_le {A B : Interface} +lemma distance_parallel_le {A B : Interface} (R S : Resource A) (T U : Resource B) : Δ (R ∥ T) (S ∥ U) ≤ Δ R S + Δ T U := ConstructiveCryptography.CryptographicAlgebra.distance_parallel_le diff --git a/src/ConstructiveCryptography/PresentedGame.lean b/src/ConstructiveCryptography/PresentedGame.lean index 2624c8e..5c7d96d 100644 --- a/src/ConstructiveCryptography/PresentedGame.lean +++ b/src/ConstructiveCryptography/PresentedGame.lean @@ -61,7 +61,7 @@ noncomputable def ofPDG (G : PDG (Σ i, A.X i) (Σ i, A.Y i) A.inputDomain) (hG /-- The visible resource of the game a probabilistic discrete game presents is the resource its visible systems present. -/ -theorem visible_ofPDG (G : PDG (Σ i, A.X i) (Σ i, A.Y i) A.inputDomain) (hG : G.isProbDist) +lemma visible_ofPDG (G : PDG (Σ i, A.X i) (Σ i, A.Y i) A.inputDomain) (hG : G.isProbDist) {R : Resource A} (visible : R.1 = PDS.behavior G.underlying (PDG.underlying_probability hG)) : DistinctionGames.visible (ofPDG G hG visible) = R := -- The visible system of the behavior of `G` is the behavior of its visible systems @@ -71,7 +71,7 @@ theorem visible_ofPDG (G : PDG (Σ i, A.X i) (Σ i, A.Y i) A.inputDomain) (hG : /-- The game a probabilistic discrete game presents is conditionally equivalent to a resource exactly when its game on random systems is conditionally equivalent to the resource's random system. -/ -theorem conditionallyEquivalent_ofPDG_iff (G : PDG (Σ i, A.X i) (Σ i, A.Y i) A.inputDomain) +lemma conditionallyEquivalent_ofPDG_iff (G : PDG (Σ i, A.X i) (Σ i, A.Y i) A.inputDomain) (hG : G.isProbDist) {R : Resource A} (visible : R.1 = PDS.behavior G.underlying (PDG.underlying_probability hG)) (S : Resource A) : ofPDG G hG visible |≡ S ↔ (G.behavior hG).ConditionallyEquivalent S.1 := @@ -104,7 +104,7 @@ theorem game_dist_le {A : Interface} /-- **The resource sampling a single-label function** is the behavior of the visible systems of the sampled-function game. -/ -theorem Resource.sample_ofFunction_eq_behavior {I K X Y : Type} [Unique I] [Fintype X] +lemma Resource.sample_ofFunction_eq_behavior {I K X Y : Type} [Unique I] [Fintype X] [Fintype Y] (D : List (Σ _ : I, X) → Prop) (hD : ¬ D [] ∧ ∀ {p h}, p <+: h → p ≠ [] → D h → D p) (bound : ℕ) (hb : ∀ h, D h → h.length ≤ bound) (P : Distribution K) [Distribution.IsProbability P] @@ -142,7 +142,7 @@ open Classical in /-- **A single-label sampled-function game is conditionally equivalent to the resource sampling the ideal function** when, on every fixed query sequence, the answers jointly with the unset condition factor through the ideal answers. -/ -theorem ofSingleFunction_conditionallyEquivalent {I K X Y : Type} [Unique I] [Fintype X] +lemma ofSingleFunction_conditionallyEquivalent {I K X Y : Type} [Unique I] [Fintype X] [Fintype Y] (D : List (Σ _ : I, X) → Prop) (hD : ¬ D [] ∧ ∀ {p h}, p <+: h → p ≠ [] → D h → D p) (bound : ℕ) (hb : ∀ h, D h → h.length ≤ bound) @@ -213,7 +213,7 @@ theorem ofSingleFunction_conditionallyEquivalent {I K X Y : Type} [Unique I] [Fi sampling the function is at most `ε` from a resource conditionally equivalent to the game when the sampled condition holds with probability at most `ε` on the empty and on every admitted query sequence. -/ -theorem game_dist_ofSingleFunction_le {I K X Y : Type} +lemma game_dist_ofSingleFunction_le {I K X Y : Type} [Unique I] [Fintype X] [Fintype Y] {D : List (Σ _ : I, X) → Prop} {hD : ¬ D [] ∧ ∀ {p h}, p <+: h → p ≠ [] → D h → D p} {bound : ℕ} {hb : ∀ h, D h → h.length ≤ bound} diff --git a/src/ConstructiveCryptography/ResourceCoherence.lean b/src/ConstructiveCryptography/ResourceCoherence.lean index 3a26d90..75e05be 100644 --- a/src/ConstructiveCryptography/ResourceCoherence.lean +++ b/src/ConstructiveCryptography/ResourceCoherence.lean @@ -24,7 +24,7 @@ namespace SystemAlgebra.Interface open Classical Probability CategoryTheory -theorem parallel_mass_of_presentations_raw {A B : Interface} {ι κ : Type} +lemma parallel_mass_of_presentations_raw {A B : Interface} {ι κ : Type} (R : Resource A) (S : Resource B) (P : Distribution ι) (Q : Distribution κ) (s : ι → InterfaceSystem A.I A.X A.Y) (t : κ → InterfaceSystem B.I B.X B.Y) (hR : ∀ h, R.1 h = P.mass (fun i => Replies (s i) (h.map Prod.fst) (h.map Prod.snd))) @@ -37,7 +37,7 @@ theorem parallel_mass_of_presentations_raw {A B : Interface} {ι κ : Type} rw [parallel_mass_of_presentations R S P Q s t hR hS] exact Distribution.mass_congr _ (fun _ => by rw [replies_relabel_iff, replies_relabel_iff, replies_trim_iff]) -theorem parallel_system_assoc {A B C : Interface} +lemma parallel_system_assoc {A B C : Interface} (a : InterfaceSystem A.I A.X A.Y) (b : InterfaceSystem B.I B.X B.Y) (c : InterfaceSystem C.I C.X C.Y) : relabel (pair (relabel (pair a b) (sumAlphabet (Sum.rec A.X B.X)).symm (sumAlphabet (Sum.rec A.Y B.Y))) c) @@ -58,7 +58,7 @@ theorem parallel_system_assoc {A B C : Interface} · rfl · rcases z with ⟨(_ | ⟨⟨⟩⟩), z⟩ <;> rfl -theorem parallel_assoc_mass_of_presentations {A B C : Interface} {ι κ ν : Type} +lemma parallel_assoc_mass_of_presentations {A B C : Interface} {ι κ ν : Type} (R : Resource A) (S : Resource B) (T : Resource C) (P : Distribution ι) (Q : Distribution κ) (U : Distribution ν) (s : ι → InterfaceSystem A.I A.X A.Y) (t : κ → InterfaceSystem B.I B.X B.Y) (u : ν → InterfaceSystem C.I C.X C.Y) @@ -78,7 +78,7 @@ theorem parallel_assoc_mass_of_presentations {A B C : Interface} {ι κ ν : Typ rw [parallel_system_assoc, replies_relabel_iff] rfl -theorem parallel_assoc_mass {A B C : Interface} (R : Resource A) (S : Resource B) (T : Resource C) +lemma parallel_assoc_mass {A B C : Interface} (R : Resource A) (S : Resource B) (T : Resource C) (h : List ((Σ i, (tensor (tensor A B) C).X i) × (Σ i, (tensor (tensor A B) C).Y i))) : (parallel (parallel R S) T).1 h = (parallel R (parallel S T)).1 (h.map ((assocAlphabet A.X B.X C.X).prodCongr (assocAlphabet A.Y B.Y C.Y))) := by @@ -88,7 +88,7 @@ theorem parallel_assoc_mass {A B C : Interface} (R : Resource A) (S : Resource B exact parallel_assoc_mass_of_presentations _ _ _ P.1 Q.1 U.1 Subtype.val Subtype.val Subtype.val (fun _ => rfl) (fun _ => rfl) (fun _ => rfl) h -theorem parallel_assoc {A B C : Interface} (R : Resource A) (S : Resource B) (T : Resource C) : +lemma parallel_assoc {A B C : Interface} (R : Resource A) (S : Resource B) (T : Resource C) : ((associator A B C).inv • parallel (parallel R S) T : Resource (tensor A (tensor B C))) = parallel R (parallel S T) := by apply Subtype.ext @@ -105,7 +105,7 @@ noncomputable def dummy : Resource unit := fun _ _ _ h => (Part.not_none_dom h.1).elim, fun _ => iff_of_false Part.not_none_dom id⟩ -theorem parallel_unit_left_mass {A : Interface} (R : Resource A) +lemma parallel_unit_left_mass {A : Interface} (R : Resource A) (h : List ((Σ i, (tensor unit A).X i) × (Σ i, (tensor unit A).Y i))) : (parallel dummy R).1 h = R.1 (h.map ((leftUnitAlphabet A.X).prodCongr (leftUnitAlphabet A.Y))) := by @@ -130,7 +130,7 @@ theorem parallel_unit_left_mass {A : Interface} (R : Resource A) change RandomSystem.parallel dummy.1 R.1 k = _ rw [RandomSystem.parallel_mass, if_pos hp.1, hp.2.1, hp.2.2, dummy.1.mass_nil, one_mul] -theorem parallel_unit_right_mass {A : Interface} (R : Resource A) +lemma parallel_unit_right_mass {A : Interface} (R : Resource A) (h : List ((Σ i, (tensor A unit).X i) × (Σ i, (tensor A unit).Y i))) : (parallel R dummy).1 h = R.1 (h.map ((rightUnitAlphabet A.X).prodCongr (rightUnitAlphabet A.Y))) := by @@ -155,7 +155,7 @@ theorem parallel_unit_right_mass {A : Interface} (R : Resource A) change RandomSystem.parallel R.1 dummy.1 k = _ rw [RandomSystem.parallel_mass, if_pos hp.1, hp.2.1, hp.2.2, dummy.1.mass_nil, mul_one] -theorem parallel_dummy_left {A : Interface} (R : Resource A) : +lemma parallel_dummy_left {A : Interface} (R : Resource A) : ((leftUnitor A).inv • parallel dummy R : Resource A) = R := by apply Subtype.ext apply RandomSystem.ext @@ -164,7 +164,7 @@ theorem parallel_dummy_left {A : Interface} (R : Resource A) : rw [rename_mass, parallel_unit_left_mass] simp only [← Equiv.prodCongr_symm, List.map_map, Equiv.self_comp_symm, List.map_id] -theorem parallel_dummy_right {A : Interface} (R : Resource A) : +lemma parallel_dummy_right {A : Interface} (R : Resource A) : ((rightUnitor A).inv • parallel R dummy : Resource A) = R := by apply Subtype.ext apply RandomSystem.ext @@ -179,7 +179,7 @@ noncomputable def swap (A B : Interface) : tensor A B ≅ tensor B A := (by rintro ⟨(i | j), x⟩ <;> rfl) (by rintro ⟨(i | j), y⟩ <;> rfl) (parallelDomain_swap A B) -theorem parallel_swap_mass {A B : Interface} (R : Resource A) (S : Resource B) +lemma parallel_swap_mass {A B : Interface} (R : Resource A) (S : Resource B) (h : List ((Σ i, (tensor A B).X i) × (Σ i, (tensor A B).Y i))) : (parallel S R).1 (h.map ((swapAlphabet A.X B.X).prodCongr (swapAlphabet A.Y B.Y))) = (parallel R S).1 h := by @@ -208,7 +208,7 @@ theorem parallel_swap_mass {A B : Interface} (R : Resource A) (S : Resource B) · exact mul_comm _ _ · rfl -theorem parallel_swap {A B : Interface} (R : Resource A) (S : Resource B) : +lemma parallel_swap {A B : Interface} (R : Resource A) (S : Resource B) : ((swap A B).hom • parallel S R : Resource (tensor A B)) = parallel R S := by apply Subtype.ext apply RandomSystem.ext diff --git a/src/ConstructiveCryptography/ResourceParallel.lean b/src/ConstructiveCryptography/ResourceParallel.lean index 80972af..12de699 100644 --- a/src/ConstructiveCryptography/ResourceParallel.lean +++ b/src/ConstructiveCryptography/ResourceParallel.lean @@ -18,7 +18,7 @@ namespace SystemAlgebra.Interface open Classical Probability CategoryTheory -theorem parallel_mass_of_presentations {A B : Interface} {ι κ : Type} +lemma parallel_mass_of_presentations {A B : Interface} {ι κ : Type} (R : Resource A) (S : Resource B) (P : Distribution ι) (Q : Distribution κ) (s : ι → InterfaceSystem A.I A.X A.Y) (t : κ → InterfaceSystem B.I B.X B.Y) (hR : ∀ h, R.1 h = P.mass (fun i => Replies (s i) (h.map Prod.fst) (h.map Prod.snd))) @@ -33,7 +33,7 @@ theorem parallel_mass_of_presentations {A B : Interface} {ι κ : Type} intro st rw [replies_relabel_iff, replies_trim_iff] -theorem parallel_ofPDS {A B : Interface} +lemma parallel_ofPDS {A B : Interface} (P : Distribution.ProbDist {s : InterfaceSystem A.I A.X A.Y // IsDDS s ∧ RepliesAtQueriedInterface s ∧ ∀ h, (s h).Dom ↔ A.domain h}) (Q : Distribution.ProbDist {t : InterfaceSystem B.I B.X B.Y // @@ -48,7 +48,7 @@ theorem parallel_ofPDS {A B : Interface} simp only [behaviorMass, parallelPDS, Distribution.mass_fTransform] /-- A forwarding converter only renames the cumulative transcript. -/ -theorem rename_mass {A B : Interface} (e : A.I ≃ B.I) +lemma rename_mass {A B : Interface} (e : A.I ≃ B.I) (f : (Σ i, A.X i) ≃ (Σ j, B.X j)) (g : (Σ i, A.Y i) ≃ (Σ j, B.Y j)) (hf : ∀ x, (f x).1 = e x.1) (hg : ∀ y, (g y).1 = e y.1) (hd : ∀ h, B.domain (h.map f) ↔ A.domain h) (R : Resource B) diff --git a/src/ConstructiveCryptography/ResourceParallelAttachment.lean b/src/ConstructiveCryptography/ResourceParallelAttachment.lean index a7e0dc3..7c7d237 100644 --- a/src/ConstructiveCryptography/ResourceParallelAttachment.lean +++ b/src/ConstructiveCryptography/ResourceParallelAttachment.lean @@ -15,7 +15,7 @@ open Classical Probability CategoryTheory variable {A B C D : Interface} /-- **Locality**: parallel converters act on parallel resources component by component. -/ -theorem parallel_attach (α : A ⟶ B) (β : C ⟶ D) (R : Resource B) (S : Resource D) : +lemma parallel_attach (α : A ⟶ B) (β : C ⟶ D) (R : Resource B) (S : Resource D) : (parallelConverter α β • parallel R S : Resource (tensor A C)) = parallel (α • R : Resource A) (β • S : Resource C) := by obtain ⟨ba, P, hP⟩ := α.2 diff --git a/src/ConstructiveCryptography/Source.lean b/src/ConstructiveCryptography/Source.lean index ff254d1..634c82b 100644 --- a/src/ConstructiveCryptography/Source.lean +++ b/src/ConstructiveCryptography/Source.lean @@ -38,7 +38,7 @@ noncomputable def sourceStep {q : ℕ} (law : Distribution.ProbDist X) : | (t, k), _, _ => ((t, k + 1), if hk : k < q then t ⟨k, hk⟩ else Classical.choice law.nonempty) /-- After `k` queries the source reads entry `k` of its table. -/ -theorem stateAfter_sourceStep {q : ℕ} (law : Distribution.ProbDist X) (t : Fin q → X) +lemma stateAfter_sourceStep {q : ℕ} (law : Distribution.ProbDist X) (t : Fin q → X) (h : List (Σ _ : Unit, Unit)) : stateAfter (sourceStep law) (t, 0) h = (t, h.length) := by induction h using List.reverseRecOn with | nil => rfl diff --git a/src/ConstructiveCryptography/Specification/Game.lean b/src/ConstructiveCryptography/Specification/Game.lean index 3182402..3f8e40f 100644 --- a/src/ConstructiveCryptography/Specification/Game.lean +++ b/src/ConstructiveCryptography/Specification/Game.lean @@ -23,7 +23,7 @@ def ClosedUnderConverterClass (converters : Submonoid C) (fun resource => test (converter • resource)) ∈ tests /-- A test bound on the ideal is inherited by its converter-class closure. -/ -theorem star_subset_gameSpec [Preorder Bound] +lemma star_subset_gameSpec [Preorder Bound] {converters : Submonoid C} {tests : Set (X → Bound)} {error : Bound} {ideal : X} (closed : ClosedUnderConverterClass converters tests) @@ -43,7 +43,7 @@ def testClosure (converters : Submonoid C) (baseTests : Set (X → Bound)) : test = fun resource => baseTest (converter • resource)} /-- Every base test belongs to its converter closure. -/ -theorem subset_testClosure (converters : Submonoid C) +lemma subset_testClosure (converters : Submonoid C) (baseTests : Set (X → Bound)) : baseTests ⊆ testClosure converters baseTests := by intro test admitted @@ -53,7 +53,7 @@ theorem subset_testClosure (converters : Submonoid C) rw [one_smul] /-- Converter closure is closed under the same converter class. -/ -theorem closedUnderConverterClass_testClosure (converters : Submonoid C) +lemma closedUnderConverterClass_testClosure (converters : Submonoid C) (baseTests : Set (X → Bound)) : ClosedUnderConverterClass converters (testClosure converters baseTests) := by intro test testAdmitted outer outerAdmitted diff --git a/src/ConstructiveCryptography/Specification/Game/Basic.lean b/src/ConstructiveCryptography/Specification/Game/Basic.lean index c556d52..343eb32 100644 --- a/src/ConstructiveCryptography/Specification/Game/Basic.lean +++ b/src/ConstructiveCryptography/Specification/Game/Basic.lean @@ -25,14 +25,14 @@ def gameSpec (tests : Set (X → Bound)) (error : Bound) : Specification X := {resource | ∀ test ∈ tests, test resource ≤ error} /-- A larger error bound gives a weaker game specification. -/ -theorem gameSpec_mono {tests : Set (X → Bound)} +lemma gameSpec_mono {tests : Set (X → Bound)} {error error' : Bound} (included : error ≤ error') : gameSpec tests error ⊆ gameSpec tests error' := fun _ admitted test testAdmitted => le_trans (admitted test testAdmitted) included /-- More admitted tests give a stronger game specification. -/ -theorem gameSpec_antitone {tests tests' : Set (X → Bound)} +lemma gameSpec_antitone {tests tests' : Set (X → Bound)} (included : tests ⊆ tests') {error : Bound} : gameSpec tests' error ⊆ gameSpec tests error := fun _ admitted test testAdmitted => admitted test (included testAdmitted) @@ -45,7 +45,7 @@ structure MonotoneTestFamily (X : Type u) (Bound : Type v) where monotone : Monotone tests /-- A bound at a higher index implies the same bound at every lower index. -/ -theorem MonotoneTestFamily.mem_gameSpec_of_le +lemma MonotoneTestFamily.mem_gameSpec_of_le (family : MonotoneTestFamily X Bound) {lower higher : Nat} (ordered : lower ≤ higher) {error : Bound} {resource : X} diff --git a/src/ConstructiveCryptography/Specification/Maps.lean b/src/ConstructiveCryptography/Specification/Maps.lean index 576a76c..3d038f0 100644 --- a/src/ConstructiveCryptography/Specification/Maps.lean +++ b/src/ConstructiveCryptography/Specification/Maps.lean @@ -38,18 +38,18 @@ def lift (r : X → Set Y) : sSupHom (Specification X) (Specification Y) where exact ⟨x, ⟨source, admitted, member⟩, related⟩ /-- Membership in a union lift is witnessed by an admitted center. -/ -@[simp] theorem mem_lift_iff {r : X → Set Y} {source : Specification X} {y : Y} : +@[simp] lemma mem_lift_iff {r : X → Set Y} {source : Specification X} {y : Y} : y ∈ lift r source ↔ ∃ x ∈ source, y ∈ r x := by change y ∈ (⋃ x ∈ source, r x) ↔ _ simp only [Set.mem_iUnion, exists_prop] /-- The lift of a singleton specification recovers the resource map. -/ -@[simp] theorem lift_singleton (r : X → Set Y) (x : X) : +@[simp] lemma lift_singleton (r : X → Set Y) (x : X) : lift r {x} = r x := Set.biUnion_singleton x r /-- Singleton-valued resource maps lift to ordinary specification images. -/ -theorem lift_singleton_eq_setImage (f : X → Y) : +lemma lift_singleton_eq_setImage (f : X → Y) : lift (fun x => {f x}) = sSupHom.setImage f := by ext source y -- The relational witness is exactly the direct-image witness. @@ -59,7 +59,7 @@ theorem lift_singleton_eq_setImage (f : X → Y) : /-- Every union-preserving specification map is the lift of its singleton values. The calculation uses Jost's union extension (Definition 2.2.6, printed p. 20) and the decomposition of a set into singletons. -/ -theorem lift_singletons (f : sSupHom (Specification X) (Specification Y)) : +lemma lift_singletons (f : sSupHom (Specification X) (Specification Y)) : lift (fun x => f {x}) = f := by apply sSupHom.ext intro source @@ -72,7 +72,7 @@ theorem lift_singletons (f : sSupHom (Specification X) (Specification Y)) : Jost, Definition 2.2.6 (printed p. 20): “Rφ := ⋃R∈R φ(R)”. Two successive lifts retain the intermediate resource as an existential witness. -/ -theorem lift_comp (outer : Y → Set Z) (inner : X → Set Y) : +lemma lift_comp (outer : Y → Set Z) (inner : X → Set Y) : lift (fun x => lift outer (inner x)) = (lift outer).comp (lift inner) := by ext source z simp only [mem_lift_iff, sSupHom.comp_apply] diff --git a/src/ConstructiveCryptography/Specification/Metric.lean b/src/ConstructiveCryptography/Specification/Metric.lean index 266b969..67ad6a2 100644 --- a/src/ConstructiveCryptography/Specification/Metric.lean +++ b/src/ConstructiveCryptography/Specification/Metric.lean @@ -25,7 +25,7 @@ def ConstructsWithin [EDist Y] (f : X → Y) ∀ resource ∈ source, ∃ ideal ∈ target, edist (f resource) ideal ≤ error /-- Exact construction into ε-relaxation is scalar approximate construction. -/ -theorem constructs_epsilonRelaxation_iff [PseudoEMetricSpace Y] +lemma constructs_epsilonRelaxation_iff [PseudoEMetricSpace Y] {f : X → Y} {source : Specification X} {target : Specification Y} {error : ENNReal} : Constructs f source (epsilonRelaxation error target) ↔ ConstructsWithin f source target error := by @@ -33,7 +33,7 @@ theorem constructs_epsilonRelaxation_iff [PseudoEMetricSpace Y] simp only [Constructs, Set.MapsTo, mem_epsilonRelaxation_iff, ConstructsWithin] /-- Scalar-error bounds may be weakened. -/ -theorem ConstructsWithin.weaken [EDist Y] {f : X → Y} +lemma ConstructsWithin.weaken [EDist Y] {f : X → Y} {source : Specification X} {target : Specification Y} {ε δ : ENNReal} (construction : ConstructsWithin f source target ε) (bound : ε ≤ δ) : ConstructsWithin f source target δ := by @@ -67,7 +67,7 @@ theorem ConstructsWithin.serial [PseudoEMetricSpace Y] [PseudoEMetricSpace Z] MR16, Definition 2 (printed p. 11), expresses non-expansion of resource maps. Applying it to the two fixed-argument maps and using the triangle inequality gives this bound for the chosen ordered parallel operation. -/ -theorem edist_parallel_le [PseudoEMetricSpace X] [PseudoEMetricSpace Y] +lemma edist_parallel_le [PseudoEMetricSpace X] [PseudoEMetricSpace Y] [PseudoEMetricSpace Z] (parallel : X → Y → Z) (leftNonexpanding : ∀ y, LipschitzWith 1 (fun x => parallel x y)) (rightNonexpanding : ∀ x, LipschitzWith 1 (parallel x)) diff --git a/src/ConstructiveCryptography/Specification/Relaxation/Basic.lean b/src/ConstructiveCryptography/Specification/Relaxation/Basic.lean index 20375df..c90bbdc 100644 --- a/src/ConstructiveCryptography/Specification/Relaxation/Basic.lean +++ b/src/ConstructiveCryptography/Specification/Relaxation/Basic.lean @@ -27,7 +27,7 @@ theorem inter_subset (relaxation : Relaxation X) (left right : Specification X) protected def id (X : Type u) : Relaxation X := ofPointwise (fun resource => {resource}) Set.mem_singleton -@[simp] theorem id_apply (source : Specification X) : +@[simp] lemma id_apply (source : Specification X) : Relaxation.id X source = source := Set.biUnion_of_singleton source @@ -40,22 +40,22 @@ def comp (outer inner : Relaxation X) : Relaxation X where toPointwise resource := outer (inner.toPointwise resource) self_mem resource := outer.subset_apply _ (inner.self_mem resource) -@[simp] theorem comp_apply (outer inner : Relaxation X) (source : Specification X) : +@[simp] lemma comp_apply (outer inner : Relaxation X) (source : Specification X) : outer.comp inner source = outer (inner source) := congrArg (fun f : sSupHom (Specification X) (Specification X) => f source) (Specification.lift_comp outer.toPointwise inner.toPointwise) -@[simp] theorem comp_id (relaxation : Relaxation X) : +@[simp] lemma comp_id (relaxation : Relaxation X) : relaxation.comp (Relaxation.id X) = relaxation := by ext source simp only [comp_apply, id_apply] -@[simp] theorem id_comp (relaxation : Relaxation X) : +@[simp] lemma id_comp (relaxation : Relaxation X) : (Relaxation.id X).comp relaxation = relaxation := by ext source simp only [comp_apply, id_apply] -theorem comp_assoc (outer middle inner : Relaxation X) : +lemma comp_assoc (outer middle inner : Relaxation X) : (outer.comp middle).comp inner = outer.comp (middle.comp inner) := by ext source simp only [comp_apply] diff --git a/src/ConstructiveCryptography/Specification/Relaxation/Defs.lean b/src/ConstructiveCryptography/Specification/Relaxation/Defs.lean index 7e1162f..127aaa2 100644 --- a/src/ConstructiveCryptography/Specification/Relaxation/Defs.lean +++ b/src/ConstructiveCryptography/Specification/Relaxation/Defs.lean @@ -44,7 +44,7 @@ instance : sSupHomClass (Relaxation X) (Specification X) (Specification X) where map_sSup relaxation := map_sSup (Specification.lift relaxation.toPointwise) /-- A relaxation is determined by its action on specifications. -/ -@[ext] theorem ext {left right : Relaxation X} +@[ext] lemma ext {left right : Relaxation X} (equal : ∀ source, left source = right source) : left = right := DFunLike.ext left right equal @@ -64,13 +64,13 @@ def ofPointwise (relaxation : X → Specification X) /-- Specification membership is witnessed by an admitted center. Jost, Definition 2.2.6 (printed p. 20): “Rφ := ⋃R∈R φ(R)”. -/ -@[simp] theorem mem_apply_iff {relaxation : Relaxation X} +@[simp] lemma mem_apply_iff {relaxation : Relaxation X} {source : Specification X} {resource : X} : resource ∈ relaxation source ↔ ∃ center ∈ source, resource ∈ relaxation.toPointwise center := Specification.mem_lift_iff -@[simp] theorem mem_ofPointwise_iff {relaxation : X → Specification X} +@[simp] lemma mem_ofPointwise_iff {relaxation : X → Specification X} {self_mem : ∀ resource, resource ∈ relaxation resource} {source : Specification X} {resource : X} : resource ∈ ofPointwise relaxation self_mem source ↔ @@ -78,7 +78,7 @@ Jost, Definition 2.2.6 (printed p. 20): “Rφ := ⋃R∈R φ(R)”. -/ mem_apply_iff /-- Singleton specifications recover the pointwise relaxation. -/ -@[simp] theorem apply_singleton (relaxation : Relaxation X) (resource : X) : +@[simp] lemma apply_singleton (relaxation : Relaxation X) (resource : X) : relaxation {resource} = relaxation.toPointwise resource := Specification.lift_singleton _ _ diff --git a/src/ConstructiveCryptography/Specification/Relaxation/Epsilon.lean b/src/ConstructiveCryptography/Specification/Relaxation/Epsilon.lean index b54fdbb..90156b7 100644 --- a/src/ConstructiveCryptography/Specification/Relaxation/Epsilon.lean +++ b/src/ConstructiveCryptography/Specification/Relaxation/Epsilon.lean @@ -27,7 +27,7 @@ noncomputable def epsilonRelaxation (error : ENNReal) : Relaxation X := (fun resource => (le_of_eq (edist_self resource)).trans bot_le) /-- Membership is witnessed by an admitted center within the error bound. -/ -@[simp] theorem mem_epsilonRelaxation_iff {error : ENNReal} +@[simp] lemma mem_epsilonRelaxation_iff {error : ENNReal} {source : Specification X} {resource : X} : resource ∈ epsilonRelaxation error source ↔ ∃ center ∈ source, edist resource center ≤ error := diff --git a/src/ConstructiveCryptography/Specification/Relaxation/Kernel.lean b/src/ConstructiveCryptography/Specification/Relaxation/Kernel.lean index b9f6ded..c6cd2cb 100644 --- a/src/ConstructiveCryptography/Specification/Relaxation/Kernel.lean +++ b/src/ConstructiveCryptography/Specification/Relaxation/Kernel.lean @@ -17,7 +17,7 @@ def kernel {X : Type u} {Y : Type v} (view : X → Y) : Relaxation X := Relaxation.ofPointwise (fun center => {R | view R = view center}) (fun _ => rfl) /-- Kernel relaxation is the preimage of the specification image. -/ -theorem kernel_apply {X : Type u} {Y : Type v} (view : X → Y) (S : Set X) : +lemma kernel_apply {X : Type u} {Y : Type v} (view : X → Y) (S : Set X) : kernel view S = view ⁻¹' (view '' S) := by ext R -- An equal-view center is exactly a witness for membership in the image. @@ -26,7 +26,7 @@ theorem kernel_apply {X : Type u} {Y : Type v} (view : X → Y) (S : Set X) : exact exists_congr fun _ => and_congr_right fun _ => eq_comm /-- Identifying equal images twice gives the same specification. -/ -theorem kernel_idem {X : Type u} {Y : Type v} (view : X → Y) (S : Set X) : +lemma kernel_idem {X : Type u} {Y : Type v} (view : X → Y) (S : Set X) : kernel view (kernel view S) = kernel view S := by apply Set.Subset.antisymm · -- Two equal-view relations compose by transitivity. diff --git a/src/ConstructiveCryptography/Specification/Star.lean b/src/ConstructiveCryptography/Specification/Star.lean index ab05c4b..46bde3a 100644 --- a/src/ConstructiveCryptography/Specification/Star.lean +++ b/src/ConstructiveCryptography/Specification/Star.lean @@ -30,7 +30,7 @@ def star (converters : Submonoid C) (source : Specification X) : Specification X /-- The identity converter admits each original resource. MR16, Equation (1) (printed p. 8): “R ⊆ R* = (R*)*”. -/ -theorem subset_star (converters : Submonoid C) (source : Specification X) : +lemma subset_star (converters : Submonoid C) (source : Specification X) : source ⊆ star converters source := by intro resource admitted exact ⟨1, converters.one_mem, resource, admitted, one_smul C resource⟩ @@ -40,7 +40,7 @@ theorem subset_star (converters : Submonoid C) (source : Specification X) : MR16, Equation (1) (printed p. 8): “R ⊆ R* = (R*)*”. Jost, Section 2.2.5 (printed pp. 23–24), uses a specified converter class; the submonoid here supplies its identity and composition closure. -/ -theorem star_idem (converters : Submonoid C) (source : Specification X) : +lemma star_idem (converters : Submonoid C) (source : Specification X) : star converters (star converters source) = star converters source := by apply Set.Subset.antisymm · -- Replace two admitted converters by their admitted product. @@ -61,7 +61,7 @@ def starClosure (converters : Submonoid C) : ClosureOperator (Specification X) : MR16, Section 3.3 (printed p. 8): “(αR)β = α(Rβ)”. The commutation equation is required only for the admitted converters. -/ -theorem image_star_subset {f : X → X} {converters : Submonoid C} +lemma image_star_subset {f : X → X} {converters : Submonoid C} (commutes : ∀ converter ∈ converters, ∀ resource, f (converter • resource) = converter • f resource) (source : Specification X) : diff --git a/src/ConstructiveCryptography/Specification/Star/Metric.lean b/src/ConstructiveCryptography/Specification/Star/Metric.lean index d019579..7f117d2 100644 --- a/src/ConstructiveCryptography/Specification/Star/Metric.lean +++ b/src/ConstructiveCryptography/Specification/Star/Metric.lean @@ -41,7 +41,7 @@ theorem ConstructsWithin.star {f : X → X} {converters : Submonoid C} MR16, Equation (3) (printed p. 12): “πR ≈ε Sσ”. The simulator remains an explicit witness; no distance on the real resource carrier is required. -/ -theorem constructsWithin_star_of_simulator {Y : Type w} {f : Y → X} +lemma constructsWithin_star_of_simulator {Y : Type w} {f : Y → X} {converters : Submonoid C} {real : Y} {ideal : X} {error : ENNReal} (simulator : C) (admitted : simulator ∈ converters) (close : edist (f real) (simulator • ideal) ≤ error) : diff --git a/src/ConstructiveCryptography/Substitution/Basic.lean b/src/ConstructiveCryptography/Substitution/Basic.lean index 6d610b6..bd4a3bb 100644 --- a/src/ConstructiveCryptography/Substitution/Basic.lean +++ b/src/ConstructiveCryptography/Substitution/Basic.lean @@ -60,7 +60,7 @@ variable {C : Type u} [Category.{v} C] variable {Phi : C → Type w} [ResourceTheory C Phi] /-- Symmetry in Banfi's iff form. -/ -theorem substitutes_symm_iff +lemma substitutes_symm_iff (relation : SubstitutionRelation C) {A : C} {left right : Phi A} : relation.substitutes A left right ↔ @@ -117,7 +117,7 @@ Banfi 2023, Section 2.3.1 (printed p. 15): “we then collect the sum of such `p_i`'s into a value `ε`.” Each supplied step is first transformed using converter non-expansion; the exact-behavior joins contribute no additional error. -/ -theorem distance_hybrid_le [MonoidalCategory C] [CompatiblePseudoMetric C Phi] +lemma distance_hybrid_le [MonoidalCategory C] [CompatiblePseudoMetric C Phi] {n : Nat} {target : C} {source : Fin (n + 1) → C} (left right : ∀ i, Phi (source i)) (transformation : ∀ i, target ⟶ source i) @@ -211,7 +211,7 @@ def usageCount [DecidableEq ι] /-- An explicit Banfi implication witness transports valid premise substitutions to the target substitution. -/ -theorem substitutes +lemma substitutes (relation : SubstitutionRelation C) (implication : Implication boundary systems target uses) (premise : ∀ i, @@ -251,7 +251,7 @@ substitution use with a supplied statistical-distance bound. This is Banfi 2023, Section 2.3.1's quantitative extension (printed p. 15): the implication retains the same transformations, direction bits, exact joins, and endpoints, while its step errors add. -/ -theorem distance_le [MonoidalCategory C] [CompatiblePseudoMetric C Phi] +lemma distance_le [MonoidalCategory C] [CompatiblePseudoMetric C Phi] (implication : Implication boundary systems target uses) (error : Fin (uses + 1) → ENNReal) (step : ∀ use, diff --git a/src/ConstructiveCryptography/Substitution/Implication.lean b/src/ConstructiveCryptography/Substitution/Implication.lean index 78e9025..5968ed9 100644 --- a/src/ConstructiveCryptography/Substitution/Implication.lean +++ b/src/ConstructiveCryptography/Substitution/Implication.lean @@ -58,7 +58,7 @@ def withEndpoints {target : C} {uses : Nat} /-- Exact endpoint replacement does not use an assumption. Banfi, Section 2.3.1 (printed p. 14): "the number of times each substitution". -/ -theorem usageCount_withEndpoints [DecidableEq ι] {target : C} {uses : Nat} +lemma usageCount_withEndpoints [DecidableEq ι] {target : C} {uses : Nat} (implication : Implication boundary systems target uses) (left right : Phi target) (left_eq : left = implication.targetLeft) @@ -107,7 +107,7 @@ def single {target : C} (assumption : ι) (direction : Bool) /-- A one-position implication uses exactly its selected assumption once. Banfi, Section 2.3.1 (printed p. 14): "the number of times each substitution". The sole position is counted precisely when its assumption index matches. -/ -theorem usageCount_single [DecidableEq ι] {target : C} +lemma usageCount_single [DecidableEq ι] {target : C} (selected assumption : ι) (direction : Bool) (transformation : target ⟶ boundary selected) : (single (systems := systems) selected direction transformation).usageCount assumption = @@ -145,7 +145,7 @@ def map {source target : C} {uses : Nat} /-- Transforming a chain does not change the number of uses of an assumption. Banfi, Section 2.3.1 (printed p. 14): "the number of times each substitution". Only the named transformations change, not the index function being counted. -/ -theorem usageCount_map [DecidableEq ι] {source target : C} {uses : Nat} +lemma usageCount_map [DecidableEq ι] {source target : C} {uses : Nat} (implication : Implication boundary systems source uses) (converter : target ⟶ source) (assumption : ι) : (implication.map converter).usageCount assumption = implication.usageCount assumption := @@ -189,7 +189,7 @@ def reverse {target : C} {uses : Nat} /-- Reversing a chain preserves each assumption's use count. Banfi, Section 2.3.1 (printed p. 14): "`tⱼ := |{k | iₖ = j, k ∈ [n]}|`". Reversal is a permutation of those positions. -/ -theorem usageCount_reverse [DecidableEq ι] {target : C} {uses : Nat} +lemma usageCount_reverse [DecidableEq ι] {target : C} {uses : Nat} (implication : Implication boundary systems target uses) (assumption : ι) : implication.reverse.usageCount assumption = implication.usageCount assumption := by -- Count positions by their indicator, and reindex by the reversal permutation. @@ -272,7 +272,7 @@ def append {target : C} {firstUses secondUses : Nat} Banfi, Section 2.3.1 (printed p. 14), counts "`tⱼ := |{k | iₖ = j, k ∈ [n]}|`". Splitting the disjoint position ranges therefore adds their cardinalities, even when both chains use the same premise. -/ -theorem usageCount_append [DecidableEq ι] {target : C} {firstUses secondUses : Nat} +lemma usageCount_append [DecidableEq ι] {target : C} {firstUses secondUses : Nat} (first : Implication boundary systems target firstUses) (second : Implication boundary systems target secondUses) (join : first.targetRight = second.targetLeft) (assumption : ι) : diff --git a/src/ConstructiveCryptography/Substitution/Quantitative.lean b/src/ConstructiveCryptography/Substitution/Quantitative.lean index 03b7b02..c5a9015 100644 --- a/src/ConstructiveCryptography/Substitution/Quantitative.lean +++ b/src/ConstructiveCryptography/Substitution/Quantitative.lean @@ -46,7 +46,7 @@ def selectedUsageCount [DecidableEq ι] /-- An explicit finite implication accumulates the concrete losses at its transformed, oriented steps. Banfi, Section 2.3.3 (printed p. 16), keeps the loss "ε(Dκρ)" dependent on the actual reduced distinguisher. -/ -theorem substitutesWithin +lemma substitutesWithin (model : DistinguisherAdvantage C Phi Distinguisher) (implication : Implication boundary systems target uses) (error : Fin (uses + 1) → Distinguisher target → ENNReal) @@ -102,7 +102,7 @@ turning a computational premise into a scalar-distance assertion. Banfi, Section 2.3.1 (printed p. 15): "rather than a substitution". `selected` explicitly chooses the assumption positions; the remaining positions contribute their supplied statistical error once each. -/ -theorem substitutesWithin_of_mixed [MonoidalCategory C] [CompatiblePseudoMetric C Phi] +lemma substitutesWithin_of_mixed [MonoidalCategory C] [CompatiblePseudoMetric C Phi] (model : DistinguisherAdvantage C Phi Distinguisher) (implication : Implication boundary systems target uses) (selected : Fin (uses + 1) → Bool) diff --git a/src/ConstructiveCryptography/Substitution/Reduction.lean b/src/ConstructiveCryptography/Substitution/Reduction.lean index 2c003cc..e60ce8e 100644 --- a/src/ConstructiveCryptography/Substitution/Reduction.lean +++ b/src/ConstructiveCryptography/Substitution/Reduction.lean @@ -77,7 +77,7 @@ def SubstitutesWithin model.advantage A distinguisher left right ≤ error distinguisher /-- Reversing a concrete substitution preserves its error function. -/ -theorem SubstitutesWithin.symm +lemma SubstitutesWithin.symm (model : DistinguisherAdvantage C Systems Distinguisher) {A : C} {error : Distinguisher A → ENNReal} {left right : Systems A} @@ -107,7 +107,7 @@ theorem SubstitutesWithin.trans /-- A uniform statistical observation bound gives a constant concrete loss. Banfi, §2.3.1 (p. 15): “rather than a substitution”. The observation may be a transcript distribution; a resource metric or category is not required. -/ -theorem SubstitutesWithin.of_statistical +lemma SubstitutesWithin.of_statistical (model : DistinguisherAdvantage C Systems Distinguisher) {A : C} {statistical : Distinguisher A → Systems A → Systems A → ENNReal} (domination : ∀ D ∈ model.admissible A, ∀ R S, @@ -124,7 +124,7 @@ variable [Category.{v} C] {Phi : C → Type w} [ResourceTheory C Phi] advantage is dominated by distance. Banfi, Section 2.3.1 (printed p. 15), allows an approximate step "rather than a substitution". The domination hypothesis is explicit; no computational premise is promoted to a metric bound. -/ -theorem SubstitutesWithin.of_distance [MonoidalCategory C] [CompatiblePseudoMetric C Phi] +lemma SubstitutesWithin.of_distance [MonoidalCategory C] [CompatiblePseudoMetric C Phi] (model : DistinguisherAdvantage C Phi Distinguisher) {A : C} {left right : Phi A} {error : ENNReal} (domination : ∀ distinguisher ∈ model.admissible A, @@ -142,7 +142,7 @@ converter attachment and precomposes its error function. Banfi 2023, Section 2.3.3 (printed p. 16) defines the transformed loss by `ε'(D) := ε(D ∘ ρ)`. The `reduce` argument is that composed distinguisher; its admissibility and the displayed advantage equality remain explicit. -/ -theorem SubstitutesWithin.attach +lemma SubstitutesWithin.attach (model : DistinguisherAdvantage C Phi Distinguisher) {A B : C} (converter : A ⟶ B) (reduce : Distinguisher A → Distinguisher B) @@ -172,7 +172,7 @@ theorem SubstitutesWithin.attach This is the iterated form of Banfi 2023, Section 2.3.3 (printed p. 16): the final loss is `error (reduceInner (reduceOuter D))`, matching successive precomposition by the two named transformations. -/ -theorem SubstitutesWithin.attach_serial +lemma SubstitutesWithin.attach_serial (model : DistinguisherAdvantage C Phi Distinguisher) {A B D : C} (outer : A ⟶ B) (inner : B ⟶ D) (reduceOuter : Distinguisher A → Distinguisher B) @@ -239,7 +239,7 @@ noncomputable def reductionRelaxation exact bot_le) @[simp] -theorem mem_reductionRelaxation_iff +lemma mem_reductionRelaxation_iff (model : DistinguisherAdvantage C Phi Distinguisher) {A : C} {error : Distinguisher A → ENNReal} {source : Specification (Phi A)} {resource : Phi A} : @@ -277,7 +277,7 @@ construction into Jost's reduction relaxation. Jost, Definition 2.2.9 (printed p. 22): "R^ε := {S | ∀D : |Δᴰ(R,S)| ≤ ε(D)}". MR16, Definition 1 (printed p. 11): "π R ⊆ S". The supplied ideal may already have its explicitly chosen simulator attached. -/ -theorem constructs_singleton_reductionRelaxation_iff +lemma constructs_singleton_reductionRelaxation_iff (model : DistinguisherAdvantage C Phi Distinguisher) {A B : C} {protocol : A ⟶ B} {real : Phi B} {ideal : Phi A} {error : Distinguisher A → ENNReal} : diff --git a/src/ConstructiveCryptography/Substitution/Relaxation.lean b/src/ConstructiveCryptography/Substitution/Relaxation.lean index 4529089..6aff179 100644 --- a/src/ConstructiveCryptography/Substitution/Relaxation.lean +++ b/src/ConstructiveCryptography/Substitution/Relaxation.lean @@ -70,7 +70,7 @@ def singleSubstitutionRelaxation {A B : C} exact ⟨transformation, allowed, leftEq.symm, rightEq⟩) /-- The pointwise relaxation lifts to exactly Banfi's one-use image. -/ -@[simp] theorem singleSubstitutionRelaxation_apply {A B : C} +@[simp] lemma singleSubstitutionRelaxation_apply {A B : C} (transformations : Set (A ⟶ B)) (left right : Phi B) (diagonal : ∀ resource : Phi A, ∃ transformation ∈ transformations, @@ -95,7 +95,7 @@ explicit class of admitted transformations by serial composition. Banfi, Section 4.1.4 (printed p. 76), requires an "(efficient) transformation"; the admitted-class closure here is explicit. The attachment equation is the existing categorical law, not an additional system-specific axiom. -/ -theorem map_substitutionImage_subset {A B D : C} (converter : A ⟶ B) +lemma map_substitutionImage_subset {A B D : C} (converter : A ⟶ B) (sourceTransformations : Set (B ⟶ D)) (targetTransformations : Set (A ⟶ D)) (closed : ∀ transformation ∈ sourceTransformations, converter ≫ transformation ∈ targetTransformations) @@ -116,7 +116,7 @@ under exactly the supplied transformation-closure hypothesis. This is the converter compatibility of Banfi's Section 4.1.4 image (printed p. 76), with the "(efficient) transformation" requirement kept as explicit data and closure, rather than inferred from a generic category. -/ -theorem singleSubstitutionRelaxation_compatible {B : C} +lemma singleSubstitutionRelaxation_compatible {B : C} (transformations : ∀ A : C, Set (A ⟶ B)) (left right : Phi B) (diagonal : ∀ A (resource : Phi A), ∃ transformation ∈ transformations A, @@ -138,7 +138,7 @@ endpoint equations. Banfi, Equation (4.2) (printed p. 76): "`π REAL ∈ (σ IDEAL)^s`". The singleton specification interpretation uses the existing `Constructs` and does not require an unsupported extensivity or idempotence claim. -/ -theorem constructs_singleton_substitutionImage_iff {A B D E : C} +lemma constructs_singleton_substitutionImage_iff {A B D E : C} (transformations : Set (A ⟶ B)) (left right : Phi B) (protocol : A ⟶ D) (simulator : A ⟶ E) (real : Phi D) (ideal : Phi E) : @@ -170,7 +170,7 @@ noncomputable def substitutionRelaxation ((reflexive A).refl) @[simp] -theorem mem_substitutionRelaxation_iff +lemma mem_substitutionRelaxation_iff (relation : SubstitutionRelation C) (reflexive : ∀ A, Std.Refl (relation.substitutes A)) {A : C} {source : Specification (Phi A)} {resource : Phi A} : @@ -179,7 +179,7 @@ theorem mem_substitutionRelaxation_iff ConstructiveCryptography.Relaxation.mem_ofPointwise_iff /-- Substitution relaxation is compatible with converter attachment. -/ -theorem substitutionRelaxation_compatible +lemma substitutionRelaxation_compatible (relation : SubstitutionRelation C) (reflexive : ∀ A, Std.Refl (relation.substitutes A)) : Relaxation.Compatible @@ -199,7 +199,7 @@ For the finite-chain implication of Banfi, Section 2.3.1 (printed pp. 14--15), transitivity concatenates the chains to an admitted center. The theorem uses that explicit transitivity hypothesis; it is not an idempotence claim for the single-use description in Section 4.1.4 (printed p. 76). -/ -theorem substitutionRelaxation_idem +lemma substitutionRelaxation_idem (relation : SubstitutionRelation C) (reflexive : ∀ A, Std.Refl (relation.substitutes A)) {A : C} (source : Specification (Phi A)) : @@ -225,7 +225,7 @@ substitution relaxation of an explicitly simulated ideal resource. Banfi 2023, Definition 2.4.3 (printed p. 28) requires a simulator `σ` and the substitution `π REAL` versus `σ IDEAL`; Equation (4.2), printed p. 76, writes the same statement as `π REAL ∈ (σ IDEAL)^s`. -/ -theorem constructs_singleton_substitutionRelaxation_iff +lemma constructs_singleton_substitutionRelaxation_iff (relation : SubstitutionRelation C) (reflexive : ∀ A, Std.Refl (relation.substitutes A)) {A B : C} {protocol : A ⟶ B} {simulator : A ⟶ A} diff --git a/src/Examples/AuthenticatedEncryption/Collision.lean b/src/Examples/AuthenticatedEncryption/Collision.lean index 487b4a1..9fa115e 100644 --- a/src/Examples/AuthenticatedEncryption/Collision.lean +++ b/src/Examples/AuthenticatedEncryption/Collision.lean @@ -43,7 +43,7 @@ def Collision {k : ℕ} (law : Distribution.ProbDist M) (known : List M) (t : Fi omit [Fintype K] [Fintype M] [DecidableEq K] [DecidableEq M] in /-- Within the table's size, a source reads the table. -/ -theorem entry_of_lt {k : ℕ} (law : Distribution.ProbDist M) (t : Fin k → M) {i : ℕ} +lemma entry_of_lt {k : ℕ} (law : Distribution.ProbDist M) (t : Fin k → M) {i : ℕ} (hi : i < k) : entry law t i = t ⟨i, hi⟩ := by -- The source's step at position `i < k` reads the table entry `t ⟨i, hi⟩`. simp [entry, sourceStep, hi] @@ -51,7 +51,7 @@ theorem entry_of_lt {k : ℕ} (law : Distribution.ProbDist M) (t : Fin k → M) omit [Fintype C] [Fintype K] [DecidableEq K] [DecidableEq M] in /-- **The collision probability** of `n` original messages and a uniform table is at most `n² / |M|`. -/ -theorem collision_mass_le [Nonempty M] {k : ℕ} (known : List M) (hk : known.length ≤ k) : +lemma collision_mass_le [Nonempty M] {k : ℕ} (known : List M) (hk : known.length ≤ k) : (tableLaw 𝒰[M] k).mass (Collision 𝒰[M] known) ≤ (known.length : ℝ) ^ 2 / Fintype.card M := by -- Plan, with `n = |known|` (a union bound over pairs): -- 1. a collision is a pair `(i, m)`, `i < n` and `m` an original message, with @@ -117,7 +117,7 @@ variable [DecidableEq C] [Nonempty M] (scheme : SymmetricEncryption K M C) omit [Fintype K] [Fintype M] [Fintype C] [DecidableEq K] [DecidableEq M] [Nonempty M] in /-- A replayed message is one of the recorded messages. -/ -theorem replay_mem {l : List M} {l' : List C} {c : C} {m : M} +lemma replay_mem {l : List M} {l' : List C} {c : C} {m : M} (h : AE.replay (l.zip l') c = some m) : m ∈ l := by -- `replay` returns the message of the first entry `e` of the table whose ciphertext is `c`. obtain ⟨e, he, rfl⟩ := Option.map_eq_some_iff.mp h @@ -128,7 +128,7 @@ theorem replay_mem {l : List M} {l' : List C} {c : C} {m : M} outer table and passes the outer plaintext filter, its message being an original one, and a fresh ciphertext survives both filters only if its message is an original and a replacement message. -/ -theorem hybridDecrypt_eq {k k' : ℕ} +lemma hybridDecrypt_eq {k k' : ℕ} (ω : (((Fin k → K) × (Fin k → (K × M → C))) × (Fin k' → M)) × (Fin k' → M)) (known : List M) (c : C) (hgood : ¬ Collision (AE.CCA.law1 M C) known ω.2) : hybridDecrypt scheme ω known c = @@ -184,14 +184,14 @@ theorem hybridDecrypt_eq {k k' : ℕ} · simp [AE.retain, h₁] omit [DecidableEq M] [DecidableEq C] [Nonempty M] in -theorem messages_prefix {h h' : List (Σ p, AE.Input M C p)} (hp : h <+: h') : +lemma messages_prefix {h h' : List (Σ p, AE.Input M C p)} (hp : h <+: h') : messages h <+: messages h' := by -- `h' = h ++ e`, and `messages (h ++ e) = messages h ++ messages e`. obtain ⟨e, rfl⟩ := hp exact ⟨messages e, (messages_append h e).symm⟩ /-- **Without a collision, the hybrid oracle replies as the ideal oracle.** -/ -theorem hybrid_replies_iff {k k' : ℕ} +lemma hybrid_replies_iff {k k' : ℕ} (ω : (((Fin k → K) × (Fin k → (K × M → C))) × (Fin k' → M)) × (Fin k' → M)) (D : List (Σ p, AE.Input M C p) → Prop) (xs : List (Σ p, AE.Input M C p)) (ys : List (Σ p, AE.Output M C p)) (hgood : ¬ Collision (AE.CCA.law1 M C) (messages xs) ω.2) : @@ -231,7 +231,7 @@ variable [DecidableEq C] [Nonempty M] (scheme : SymmetricEncryption K M C) (q : omit [Fintype K] [DecidableEq K] [DecidableEq M] [DecidableEq C] [Nonempty M] in /-- The encrypted messages are the queries at the encryption port. -/ -theorem length_messages (xs : List (Σ p, AE.Input M C p)) : +lemma length_messages (xs : List (Σ p, AE.Input M C p)) : (messages xs).length = (SystemAlgebra.restrict AE.Port.enc xs).length := by -- Induction on the history: an encryption query adds one message and one query at the -- encryption port; a decryption query adds neither. @@ -245,7 +245,7 @@ theorem length_messages (xs : List (Σ p, AE.Input M C p)) : omit [Fintype K] [Fintype M] [Fintype C] [DecidableEq K] [DecidableEq M] [DecidableEq C] [Nonempty M] in /-- The first `k'` entries of a table read as the table. -/ -theorem entry_castLE {X : Type} (law : Distribution.ProbDist X) {k' k : ℕ} (h : k' ≤ k) +lemma entry_castLE {X : Type} (law : Distribution.ProbDist X) {k' k : ℕ} (h : k' ≤ k) (t : Fin k → X) {i : ℕ} (hi : i < k') : entry law (fun j : Fin k' => t (Fin.castLE h j)) i = entry law t i := by -- `i < k' ≤ k` indexes both tables, and both read the entry `t i`. @@ -253,7 +253,7 @@ theorem entry_castLE {X : Type} (law : Distribution.ProbDist X) {k' k : ℕ} (h omit [Fintype K] in /-- The real system's tables in the ideal are no larger than in the hybrid. -/ -theorem idealTableSize_le : idealTableSize scheme q ≤ AE.Real.bound scheme * ∑ i, q i := by +lemma idealTableSize_le : idealTableSize scheme q ≤ AE.Real.bound scheme * ∑ i, q i := by -- The encryption system inside the ideal has the single port `enc`, with budget `q enc`. have : ∑ i, AE.Ideal.insideBudget M C q i = q .enc := by rw [Fintype.sum_eq_single Encryption.Port.enc (fun j hj => absurd (by cases j; rfl) hj)] @@ -265,7 +265,7 @@ theorem idealTableSize_le : idealTableSize scheme q ≤ AE.Real.bound scheme * (Finset.mem_univ AE.Port.enc)) omit [Fintype K] in -theorem lt_idealTableSize {i : ℕ} (hi : i < q .enc) : i < idealTableSize scheme q := by +lemma lt_idealTableSize {i : ℕ} (hi : i < q .enc) : i < idealTableSize scheme q := by -- As in `idealTableSize_le`, the inside budget sums to `q enc`. have : ∑ i, AE.Ideal.insideBudget M C q i = q .enc := by rw [Fintype.sum_eq_single Encryption.Port.enc (fun j hj => absurd (by cases j; rfl) hj)] @@ -285,7 +285,7 @@ noncomputable abbrev truncateTables {k₂ : ℕ} : /-- **The ideal oracle reads only the first entries**: on the histories within the budget, it answers on the real system's tables as on their first entries. -/ -theorem ideal_truncate {k₂ : ℕ} +lemma ideal_truncate {k₂ : ℕ} (ω : ((Fin (AE.Real.bound scheme * ∑ i, q i) → K) × (Fin (AE.Real.bound scheme * ∑ i, q i) → (K × M → C))) × (Fin k₂ → M)) : filterDom (AE.perPort M C q).domain (automatonSystem (oracleStep (idealEncrypt scheme) @@ -329,7 +329,7 @@ theorem ideal_truncate {k₂ : ℕ} · rfl /-- **The ideal oracle on the hybrid's tables** has the mass it has on the ideal's own tables. -/ -theorem ideal_mass_hybridTables (xs : List (Σ i, (AE.perPort M C q).X i)) +lemma ideal_mass_hybridTables (xs : List (Σ i, (AE.perPort M C q).X i)) (ys : List (Σ i, (AE.perPort M C q).Y i)) : (Distribution.prod (Distribution.prod (tableLaw (AE.Real.law1 scheme) (AE.Real.bound scheme * ∑ i, q i)) @@ -390,7 +390,7 @@ noncomputable abbrev hybridLaw := (tableLaw (AE.CCA.law1 M C) (AE.CCA.bound M C * ∑ i, q i))) (tableLaw (AE.CCA.law1 M C) (AE.CCA.bound M C * ∑ i, q i)) -theorem hybridLaw_isProbDist : (hybridLaw scheme q).isProbDist := by +lemma hybridLaw_isProbDist : (hybridLaw scheme q).isProbDist := by -- A product of probability laws is one, and each table law is one. repeat' (first | apply Distribution.prod_isProbDist | exact tableLaw_isProbDist _ _) @@ -416,11 +416,11 @@ noncomputable def collisionGame : ⟨hd, fun he => (AE.perPort M C q).nonempty_prefix.1 (he ▸ hd)⟩⟩⟩) (hybridLaw scheme q) -theorem collisionGame_isProbDist : (collisionGame scheme q).isProbDist := +lemma collisionGame_isProbDist : (collisionGame scheme q).isProbDist := Distribution.fTransform_isProbDist _ (hybridLaw_isProbDist scheme q) /-- The hybrid is the behavior of the collision game's visible systems. -/ -theorem hybrid_visible : (Hybrid scheme q).1 = PDS.behavior (collisionGame scheme q).underlying +lemma hybrid_visible : (Hybrid scheme q).1 = PDS.behavior (collisionGame scheme q).underlying (PDG.underlying_probability (collisionGame_isProbDist scheme q)) := by -- Compare the two random systems transcript by transcript. apply RandomSystem.ext @@ -433,7 +433,7 @@ theorem hybrid_visible : (Hybrid scheme q).1 = PDS.behavior (collisionGame schem Distribution.mass_fTransform, Distribution.mass_fTransform] /-- The condition holds with the probability of a collision with the outer replacement table. -/ -theorem collisionGame_badProbability (xs : List (Σ i, (AE.perPort M C q).X i)) : +lemma collisionGame_badProbability (xs : List (Σ i, (AE.perPort M C q).X i)) : (collisionGame scheme q).badProbability xs = (tableLaw (AE.CCA.law1 M C) (AE.CCA.bound M C * ∑ i, q i)).mass (Collision (AE.CCA.law1 M C) (messages xs)) := by @@ -452,7 +452,7 @@ theorem collisionGame_badProbability (xs : List (Σ i, (AE.perPort M C q).X i)) /-- **The collision game is conditionally equivalent to the ideal**: the replies with no collision are the ideal replies, independently of the outer replacement table. -/ -theorem collisionGame_conditionallyEquivalent : +lemma collisionGame_conditionallyEquivalent : Interface.Game.ofPDG (collisionGame scheme q) (collisionGame_isProbDist scheme q) (hybrid_visible scheme q) |≡ (AE.Ideal.perPort M C (budget := q) • Encryption.Real.perPort scheme : diff --git a/src/Examples/AuthenticatedEncryption/Hybrid.lean b/src/Examples/AuthenticatedEncryption/Hybrid.lean index 1fc1dc3..a19faf4 100644 --- a/src/Examples/AuthenticatedEncryption/Hybrid.lean +++ b/src/Examples/AuthenticatedEncryption/Hybrid.lean @@ -35,12 +35,12 @@ noncomputable abbrev tableLaw {X : Type} (law : Distribution.ProbDist X) (k : Distribution.pi fun _ => law.1 omit [Fintype K] [Fintype M] [Fintype C] [DecidableEq K] [DecidableEq M] in -theorem tableLaw_isProbDist {X : Type} (law : Distribution.ProbDist X) (k : ℕ) : +lemma tableLaw_isProbDist {X : Type} (law : Distribution.ProbDist X) (k : ℕ) : (tableLaw law k).isProbDist := Distribution.pi_isProbDist fun _ => law.2 /-- **The real system is an automaton** on its key and encryption tables. -/ -theorem real_eq (scheme : SymmetricEncryption K M C) (q : AE.Port → ℕ) : +lemma real_eq (scheme : SymmetricEncryption K M C) (q : AE.Port → ℕ) : AE.Real.perPort scheme (budget := q) = Resource.ofAutomaton (AE.perPort M C q) (realStep scheme (AE.Real.bound scheme * ∑ i, q i)) ⟨Distribution.fTransform (fun ω => (none, ((ω.1, 0), (ω.2, 0)))) @@ -58,7 +58,7 @@ theorem real_eq (scheme : SymmetricEncryption K M C) (q : AE.Port → ℕ) : rfl /-- **The real encryption system is an automaton** on its key and encryption tables. -/ -theorem encryptionReal_eq (scheme : SymmetricEncryption K M C) (q : Encryption.Port → ℕ) : +lemma encryptionReal_eq (scheme : SymmetricEncryption K M C) (q : Encryption.Port → ℕ) : Encryption.Real.perPort scheme (budget := q) = Resource.ofAutomaton (Encryption.perPort M C q) (encryptionRealStep scheme (Encryption.Real.bound scheme * ∑ i, q i)) ⟨Distribution.fTransform (fun ω => (none, ((ω.1, 0), (ω.2, 0)))) @@ -82,7 +82,7 @@ noncomputable abbrev ptxtStep {S : Type} (AE.PTXT.body M C).combine step (AE.PTXT.bound_spec M C) /-- **The plaintext filter on an automaton** is its automaton on the same tables. -/ -theorem ptxt_smul {Ω S : Type} (q : AE.Port → ℕ) +lemma ptxt_smul {Ω S : Type} (q : AE.Port → ℕ) (step : S → (p : AE.Port) → AE.Input M C p → S × AE.Output M C p) (L : Distribution Ω) (hL : L.isProbDist) (init : Ω → S) : AE.PTXT.perPort M C (budget := q) • Resource.ofAutomaton (AE.perPort M C q) step @@ -111,7 +111,7 @@ noncomputable abbrev ccaStep {S : Type} (k : ℕ) omit [DecidableEq M] in /-- **The random-message transformation on an automaton** is its automaton on the tables beside a table of replacement messages. -/ -theorem cca_smul {Ω S : Type} (q : AE.Port → ℕ) +lemma cca_smul {Ω S : Type} (q : AE.Port → ℕ) (step : S → (p : AE.Port) → AE.Input M C p → S × AE.Output M C p) (L : Distribution Ω) (hL : L.isProbDist) (init : Ω → S) : AE.CCA.perPort M C (budget := q) • Resource.ofAutomaton (AE.perPort M C q) step @@ -139,7 +139,7 @@ noncomputable abbrev aeIdealStep {S : Type} (k : ℕ) omit [DecidableEq M] in /-- **The ideal transformation on an encryption automaton** is its automaton on the tables beside a table of replacement messages. -/ -theorem aeIdeal_smul {Ω S : Type} (q : AE.Port → ℕ) +lemma aeIdeal_smul {Ω S : Type} (q : AE.Port → ℕ) (step : S → (p : Encryption.Port) → Encryption.Input M p → S × Encryption.Output C p) (L : Distribution Ω) (hL : L.isProbDist) (init : Ω → S) : AE.Ideal.perPort M C (budget := q) • @@ -163,18 +163,18 @@ end Replacement /-! ## Each stage is an oracle -/ -theorem real_system (scheme : SymmetricEncryption K M C) {k : ℕ} (ω : (Fin k → K) × (Fin k → (K × M → C))) : +lemma real_system (scheme : SymmetricEncryption K M C) {k : ℕ} (ω : (Fin k → K) × (Fin k → (K × M → C))) : automatonSystem (realStep scheme k) (none, ((ω.1, 0), (ω.2, 0))) = automatonSystem (oracleStep (realEncrypt scheme) (realDecrypt scheme)) (ω, []) := automatonSystem_eq_of_bisim _ (real_bisim scheme) ⟨rfl, rfl, rfl, Or.inl ⟨rfl, rfl⟩⟩ -theorem encryptionReal_system (scheme : SymmetricEncryption K M C) {k : ℕ} +lemma encryptionReal_system (scheme : SymmetricEncryption K M C) {k : ℕ} (ω : (Fin k → K) × (Fin k → (K × M → C))) : automatonSystem (encryptionRealStep scheme k) (none, ((ω.1, 0), (ω.2, 0))) = automatonSystem (encryptionStep (realEncrypt scheme)) (ω, []) := automatonSystem_eq_of_bisim _ (encryptionReal_bisim scheme) ⟨rfl, rfl, rfl, Or.inl ⟨rfl, rfl⟩⟩ -theorem ptxt_system {Ω S : Type} {step : S → (p : AE.Port) → AE.Input M C p → S × AE.Output M C p} +lemma ptxt_system {Ω S : Type} {step : S → (p : AE.Port) → AE.Input M C p → S × AE.Output M C p} {s : S} {encrypt : Ω → ℕ → M → C} {decrypt : Ω → List M → C → Option M} {ω : Ω} (h : automatonSystem step s = automatonSystem (oracleStep encrypt decrypt) (ω, [])) : automatonSystem (ptxtStep step) (none, s) = @@ -187,7 +187,7 @@ section Replacement variable [DecidableEq C] [Nonempty M] omit [DecidableEq M] in -theorem cca_system {Ω S : Type} {k : ℕ} +lemma cca_system {Ω S : Type} {k : ℕ} {step : S → (p : AE.Port) → AE.Input M C p → S × AE.Output M C p} {s : S} {encrypt : Ω → ℕ → M → C} {decrypt : Ω → List M → C → Option M} {ω : Ω} (h : automatonSystem step s = automatonSystem (oracleStep encrypt decrypt) (ω, [])) @@ -200,7 +200,7 @@ theorem cca_system {Ω S : Type} {k : ℕ} (automatonSystem_eq_of_bisim _ (cca_bisim encrypt decrypt) ⟨rfl, rfl, rfl, rfl, rfl⟩) omit [DecidableEq M] in -theorem aeIdeal_system {Ω S : Type} {k : ℕ} +lemma aeIdeal_system {Ω S : Type} {k : ℕ} {step : S → (p : Encryption.Port) → Encryption.Input M p → S × Encryption.Output C p} {s : S} {encrypt : Ω → ℕ → M → C} {ω : Ω} (h : automatonSystem step s = automatonSystem (encryptionStep encrypt) (ω, [])) @@ -236,7 +236,7 @@ noncomputable abbrev hybridDecrypt {k k' : ℕ} : /-- **The hybrid is the hybrid oracle** on independent key, encryption and two replacement tables. -/ -theorem hybrid_mass (h : List ((Σ i, (AE.perPort M C q).X i) × (Σ i, (AE.perPort M C q).Y i))) : +lemma hybrid_mass (h : List ((Σ i, (AE.perPort M C q).X i) × (Σ i, (AE.perPort M C q).Y i))) : (Hybrid scheme q).1 h = (Distribution.prod (Distribution.prod (Distribution.prod (tableLaw (AE.Real.law1 scheme) (AE.Real.bound scheme * ∑ i, q i)) @@ -263,7 +263,7 @@ abbrev idealTableSize : ℕ := Encryption.Real.bound scheme * ∑ i, AE.Ideal.insideBudget M C q i /-- **The ideal is the ideal oracle** on independent key, encryption and replacement tables. -/ -theorem ideal_mass (h : List ((Σ i, (AE.perPort M C q).X i) × (Σ i, (AE.perPort M C q).Y i))) : +lemma ideal_mass (h : List ((Σ i, (AE.perPort M C q).X i) × (Σ i, (AE.perPort M C q).Y i))) : (AE.Ideal.perPort M C (budget := q) • Encryption.Real.perPort scheme : Interface.Resource (AE.perPort M C q)).1 h = (Distribution.prod (Distribution.prod diff --git a/src/Examples/AuthenticatedEncryption/Oracle.lean b/src/Examples/AuthenticatedEncryption/Oracle.lean index 2f71821..81bf2dc 100644 --- a/src/Examples/AuthenticatedEncryption/Oracle.lean +++ b/src/Examples/AuthenticatedEncryption/Oracle.lean @@ -54,17 +54,17 @@ def messages : List (Σ p, AE.Input M C p) → List M := | ⟨.enc, m⟩ => some m | ⟨.dec, _⟩ => none -@[simp] theorem messages_nil : messages ([] : List (Σ p, AE.Input M C p)) = [] := rfl +@[simp] lemma messages_nil : messages ([] : List (Σ p, AE.Input M C p)) = [] := rfl -@[simp] theorem messages_append (h k : List (Σ p, AE.Input M C p)) : +@[simp] lemma messages_append (h k : List (Σ p, AE.Input M C p)) : messages (h ++ k) = messages h ++ messages k := List.filterMap_append -@[simp] theorem messages_enc (m : M) : messages (C := C) [⟨.enc, m⟩] = [m] := rfl +@[simp] lemma messages_enc (m : M) : messages (C := C) [⟨.enc, m⟩] = [m] := rfl -@[simp] theorem messages_dec (c : C) : messages (M := M) [⟨.dec, c⟩] = [] := rfl +@[simp] lemma messages_dec (c : C) : messages (M := M) [⟨.dec, c⟩] = [] := rfl /-- The oracle's state is its sample and the messages so far. -/ -theorem stateAfter_oracleStep (encrypt : Ω → ℕ → M → C) (decrypt : Ω → List M → C → Option M) +lemma stateAfter_oracleStep (encrypt : Ω → ℕ → M → C) (decrypt : Ω → List M → C → Option M) (ω : Ω) (h : List (Σ p, AE.Input M C p)) : stateAfter (oracleStep encrypt decrypt) (ω, []) h = (ω, messages h) := by induction h using List.reverseRecOn with @@ -82,7 +82,7 @@ encrypted. -/ def ptxtDecrypt (decrypt : Ω → List M → C → Option M) : Ω → List M → C → Option M := fun ω known c => AE.retain known (decrypt ω known c) -theorem ptxt_combine_enc (encrypt : Ω → ℕ → M → C) (decrypt : Ω → List M → C → Option M) +lemma ptxt_combine_enc (encrypt : Ω → ℕ → M → C) (decrypt : Ω → List M → C → Option M) (queried : Option (List M)) (ω : Ω) (known : List M) (m : M) : (AE.PTXT.body M C).combine (oracleStep encrypt decrypt) (AE.PTXT.bound_spec M C) (queried, (ω, known)) .enc m = @@ -90,7 +90,7 @@ theorem ptxt_combine_enc (encrypt : Ω → ℕ → M → C) (decrypt : Ω → Li Program.combine_eq_of_invoke _ _ (n := 1) (by cases queried <;> simp [Program.invoke, AE.PTXT.body, callProg, returnProg, oracleStep]) -theorem ptxt_combine_dec (encrypt : Ω → ℕ → M → C) (decrypt : Ω → List M → C → Option M) +lemma ptxt_combine_dec (encrypt : Ω → ℕ → M → C) (decrypt : Ω → List M → C → Option M) (queried : Option (List M)) (ω : Ω) (known : List M) (c : C) : (AE.PTXT.body M C).combine (oracleStep encrypt decrypt) (AE.PTXT.bound_spec M C) (queried, (ω, known)) .dec c = @@ -100,7 +100,7 @@ theorem ptxt_combine_dec (encrypt : Ω → ℕ → M → C) (decrypt : Ω → Li /-- **The plaintext filter on an oracle** answers encryptions as the oracle, and retains the decryptions whose message was queried. -/ -theorem ptxt_bisim (encrypt : Ω → ℕ → M → C) (decrypt : Ω → List M → C → Option M) : +lemma ptxt_bisim (encrypt : Ω → ℕ → M → C) (decrypt : Ω → List M → C → Option M) : IsBisim ((AE.PTXT.body M C).combine (oracleStep encrypt decrypt) (AE.PTXT.bound_spec M C)) (oracleStep encrypt (ptxtDecrypt decrypt)) (fun a a' => a.2 = a' ∧ a.1.getD [] = a'.2) := by @@ -150,7 +150,7 @@ noncomputable def idealDecrypt {k : ℕ} (law : Distribution.ProbDist M) (encryp Ω × (Fin k → M) → List M → C → Option M := fun ω known c => AE.replay (known.zip (replacedCiphertexts law encrypt ω.1 ω.2 known.length)) c -theorem cca_combine_enc {k : ℕ} (encrypt : Ω → ℕ → M → C) (decrypt : Ω → List M → C → Option M) +lemma cca_combine_enc {k : ℕ} (encrypt : Ω → ℕ → M → C) (decrypt : Ω → List M → C → Option M) (table : Option (List (M × C))) (ω : Ω) (known : List M) (t : Fin k → M) (n : ℕ) (m : M) : (AE.CCA.body M C).combine (parallelStep (oracleStep encrypt decrypt) (sourceStep (AE.CCA.law1 M C))) (AE.CCA.bound_spec M C) (table, ((ω, known), (t, n))) .enc m = @@ -161,7 +161,7 @@ theorem cca_combine_enc {k : ℕ} (encrypt : Ω → ℕ → M → C) (decrypt : cases table <;> simp [Program.invoke, AE.CCA.body, callProg, returnProg, oracleStep, parallelStep, entry, sourceStep]) -theorem cca_combine_dec_replay {k : ℕ} (encrypt : Ω → ℕ → M → C) +lemma cca_combine_dec_replay {k : ℕ} (encrypt : Ω → ℕ → M → C) (decrypt : Ω → List M → C → Option M) (table : Option (List (M × C))) (ω : Ω) (known : List M) (r : (Fin k → M) × ℕ) (c : C) {m : M} (hr : AE.replay (table.getD []) c = some m) : @@ -171,7 +171,7 @@ theorem cca_combine_dec_replay {k : ℕ} (encrypt : Ω → ℕ → M → C) Program.combine_eq_of_invoke _ _ (n := 0) (by cases table <;> simp_all [Program.invoke, AE.CCA.body, returnProg]) -theorem cca_combine_dec_fresh {k : ℕ} (encrypt : Ω → ℕ → M → C) +lemma cca_combine_dec_fresh {k : ℕ} (encrypt : Ω → ℕ → M → C) (decrypt : Ω → List M → C → Option M) (table : Option (List (M × C))) (ω : Ω) (known : List M) (r : (Fin k → M) × ℕ) (c : C) (hr : AE.replay (table.getD []) c = none) : (AE.CCA.body M C).combine (parallelStep (oracleStep encrypt decrypt) (sourceStep (AE.CCA.law1 M C))) @@ -184,7 +184,7 @@ theorem cca_combine_dec_fresh {k : ℕ} (encrypt : Ω → ℕ → M → C) /-- **The random-message transformation on an oracle** encrypts the replacement messages, and decrypts by replay of its own encryptions, otherwise by the oracle on the replacement messages. -/ -theorem cca_bisim {k : ℕ} (encrypt : Ω → ℕ → M → C) (decrypt : Ω → List M → C → Option M) : +lemma cca_bisim {k : ℕ} (encrypt : Ω → ℕ → M → C) (decrypt : Ω → List M → C → Option M) : IsBisim ((AE.CCA.body M C).combine (parallelStep (oracleStep encrypt decrypt) (sourceStep (AE.CCA.law1 M C))) (AE.CCA.bound_spec M C)) @@ -214,7 +214,7 @@ theorem cca_bisim {k : ℕ} (encrypt : Ω → ℕ → M → C) (decrypt : Ω → rw [cca_combine_dec_fresh _ _ _ _ _ _ _ hr] simp [oracleStep, ccaDecrypt, ← h₅, hr] -theorem aeIdeal_combine_enc {k : ℕ} (encrypt : Ω → ℕ → M → C) +lemma aeIdeal_combine_enc {k : ℕ} (encrypt : Ω → ℕ → M → C) (table : Option (List (M × C))) (ω : Ω) (known : List M) (t : Fin k → M) (n : ℕ) (m : M) : (AE.Ideal.body M C).combine (parallelStep (encryptionStep encrypt) (sourceStep (AE.Ideal.law1 M C))) @@ -226,7 +226,7 @@ theorem aeIdeal_combine_enc {k : ℕ} (encrypt : Ω → ℕ → M → C) cases table <;> simp [Program.invoke, AE.Ideal.body, callProg, returnProg, encryptionStep, parallelStep, entry, sourceStep]) -theorem aeIdeal_combine_dec {k : ℕ} (encrypt : Ω → ℕ → M → C) +lemma aeIdeal_combine_dec {k : ℕ} (encrypt : Ω → ℕ → M → C) (table : Option (List (M × C))) (ω : Ω) (known : List M) (r : (Fin k → M) × ℕ) (c : C) : (AE.Ideal.body M C).combine (parallelStep (encryptionStep encrypt) (sourceStep (AE.Ideal.law1 M C))) @@ -237,7 +237,7 @@ theorem aeIdeal_combine_dec {k : ℕ} (encrypt : Ω → ℕ → M → C) /-- **The ideal transformation on an encryption oracle** encrypts the replacement messages, and decrypts only by replay of its own encryptions. -/ -theorem aeIdeal_bisim {k : ℕ} (encrypt : Ω → ℕ → M → C) : +lemma aeIdeal_bisim {k : ℕ} (encrypt : Ω → ℕ → M → C) : IsBisim ((AE.Ideal.body M C).combine (parallelStep (encryptionStep encrypt) (sourceStep (AE.Ideal.law1 M C))) (AE.Ideal.bound_spec M C)) @@ -276,7 +276,7 @@ noncomputable abbrev realStep (k : ℕ) := (AE.Real.body scheme).combine (parallelStep (sourceStep (q := k) (AE.Real.law1 scheme)) (sourceStep (q := k) (AE.Real.law2 scheme))) (AE.Real.bound_spec scheme) -theorem real_combine_enc_first {k : ℕ} (tK : Fin k → K) (tE : Fin k → (K × M → C)) (nE : ℕ) +lemma real_combine_enc_first {k : ℕ} (tK : Fin k → K) (tE : Fin k → (K × M → C)) (nE : ℕ) (m : M) : realStep scheme k (none, ((tK, 0), (tE, nE))) .enc m = ((some (realKey scheme tK), ((tK, 1), (tE, nE + 1))), @@ -285,14 +285,14 @@ theorem real_combine_enc_first {k : ℕ} (tK : Fin k → K) (tE : Fin k → (K simp [Program.invoke, AE.Real.body, callProg, returnProg, parallelStep, sourceStep, entry, realKey]) -theorem real_combine_enc_later {k : ℕ} (key : K) (tK : Fin k → K) (nK : ℕ) +lemma real_combine_enc_later {k : ℕ} (key : K) (tK : Fin k → K) (nK : ℕ) (tE : Fin k → (K × M → C)) (nE : ℕ) (m : M) : realStep scheme k (some key, ((tK, nK), (tE, nE))) .enc m = ((some key, ((tK, nK), (tE, nE + 1))), entry (AE.Real.law2 scheme) tE nE (key, m)) := Program.combine_eq_of_invoke _ _ (n := 1) (by simp [Program.invoke, AE.Real.body, callProg, returnProg, parallelStep, sourceStep, entry]) -theorem real_combine_dec_first {k : ℕ} (tK : Fin k → K) (r : (Fin k → (K × M → C)) × ℕ) +lemma real_combine_dec_first {k : ℕ} (tK : Fin k → K) (r : (Fin k → (K × M → C)) × ℕ) (c : C) : realStep scheme k (none, ((tK, 0), r)) .dec c = ((some (realKey scheme tK), ((tK, 1), r)), scheme.dec (realKey scheme tK) c) := @@ -300,7 +300,7 @@ theorem real_combine_dec_first {k : ℕ} (tK : Fin k → K) (r : (Fin k → (K simp [Program.invoke, AE.Real.body, callProg, returnProg, parallelStep, sourceStep, entry, realKey]) -theorem real_combine_dec_later {k : ℕ} (key : K) (r : ((Fin k → K) × ℕ) × +lemma real_combine_dec_later {k : ℕ} (key : K) (r : ((Fin k → K) × ℕ) × ((Fin k → (K × M → C)) × ℕ)) (c : C) : realStep scheme k (some key, r) .dec c = ((some key, r), scheme.dec key c) := Program.combine_eq_of_invoke _ _ (n := 0) (by simp [Program.invoke, AE.Real.body, returnProg]) @@ -317,7 +317,7 @@ noncomputable def realDecrypt {k : ℕ} : /-- **The real system is an oracle**: the `i`-th encryption reads entry `i` of the encryption table under the key, and decryption decrypts under the key. -/ -theorem real_bisim {k : ℕ} : +lemma real_bisim {k : ℕ} : IsBisim (realStep scheme k (M := M) (C := C)) (oracleStep (realEncrypt scheme) (realDecrypt scheme)) (fun a a' => a.2.1.1 = a'.1.1 ∧ a.2.2.1 = a'.1.2 ∧ a.2.2.2 = a'.2.length ∧ @@ -335,10 +335,10 @@ theorem real_bisim {k : ℕ} : simp [oracleStep, realDecrypt] omit [Fintype K] [Fintype M] [Fintype C] in -theorem encryptionReal_law1 : Encryption.Real.law1 scheme = AE.Real.law1 scheme := rfl +lemma encryptionReal_law1 : Encryption.Real.law1 scheme = AE.Real.law1 scheme := rfl omit [Fintype C] in -theorem encryptionReal_law2 : Encryption.Real.law2 scheme = AE.Real.law2 scheme := rfl +lemma encryptionReal_law2 : Encryption.Real.law2 scheme = AE.Real.law2 scheme := rfl /-- The real encryption system's automaton: its program against its key and encryption sources. -/ @@ -347,7 +347,7 @@ noncomputable abbrev encryptionRealStep (k : ℕ) := (sourceStep (q := k) (Encryption.Real.law1 scheme)) (sourceStep (q := k) (Encryption.Real.law2 scheme))) (Encryption.Real.bound_spec scheme) -theorem encryptionReal_combine_first {k : ℕ} (tK : Fin k → K) (tE : Fin k → (K × M → C)) +lemma encryptionReal_combine_first {k : ℕ} (tK : Fin k → K) (tE : Fin k → (K × M → C)) (nE : ℕ) (m : M) : encryptionRealStep scheme k (none, ((tK, 0), (tE, nE))) .enc m = ((some (realKey scheme tK), ((tK, 1), (tE, nE + 1))), @@ -356,7 +356,7 @@ theorem encryptionReal_combine_first {k : ℕ} (tK : Fin k → K) (tE : Fin k simp [Program.invoke, Encryption.Real.body, callProg, returnProg, parallelStep, sourceStep, entry, realKey, encryptionReal_law1, encryptionReal_law2]) -theorem encryptionReal_combine_later {k : ℕ} (key : K) (tK : Fin k → K) (nK : ℕ) +lemma encryptionReal_combine_later {k : ℕ} (key : K) (tK : Fin k → K) (nK : ℕ) (tE : Fin k → (K × M → C)) (nE : ℕ) (m : M) : encryptionRealStep scheme k (some key, ((tK, nK), (tE, nE))) .enc m = ((some key, ((tK, nK), (tE, nE + 1))), entry (AE.Real.law2 scheme) tE nE (key, m)) := @@ -366,7 +366,7 @@ theorem encryptionReal_combine_later {k : ℕ} (key : K) (tK : Fin k → K) (nK /-- **The real encryption system is an encryption oracle**: the `i`-th encryption reads entry `i` of the encryption table under the key. -/ -theorem encryptionReal_bisim {k : ℕ} : +lemma encryptionReal_bisim {k : ℕ} : IsBisim (encryptionRealStep scheme k (M := M) (C := C)) (encryptionStep (realEncrypt scheme)) (fun a a' => a.2.1.1 = a'.1.1 ∧ a.2.2.1 = a'.1.2 ∧ a.2.2.2 = a'.2.length ∧ @@ -384,7 +384,7 @@ end Systems /-- **Oracles that agree on the first `n` encryptions** have the same system on the histories of at most `n` encryptions. -/ -theorem oracle_system_congr {Ω' : Type} {encrypt : Ω → ℕ → M → C} +lemma oracle_system_congr {Ω' : Type} {encrypt : Ω → ℕ → M → C} {decrypt : Ω → List M → C → Option M} {encrypt' : Ω' → ℕ → M → C} {decrypt' : Ω' → List M → C → Option M} {ω : Ω} {ω' : Ω'} {n : ℕ} (henc : ∀ i < n, ∀ m, encrypt ω i m = encrypt' ω' i m) diff --git a/src/Examples/AuthenticatedEncryption/Security.lean b/src/Examples/AuthenticatedEncryption/Security.lean index 72e03dd..4ee3dda 100644 --- a/src/Examples/AuthenticatedEncryption/Security.lean +++ b/src/Examples/AuthenticatedEncryption/Security.lean @@ -109,12 +109,12 @@ noncomputable def correctedChain : rw [comp_smul, comp_smul]; rfl /-- The corrected chain uses `ind-cca` twice. -/ -theorem correctedChain_cca : (correctedChain scheme q).usageCount .cca = 2 := by +lemma correctedChain_cca : (correctedChain scheme q).usageCount .cca = 2 := by cc_usage rfl /-- The corrected chain uses `int-ptxt` twice. -/ -theorem correctedChain_ptxt : (correctedChain scheme q).usageCount .ptxt = 2 := by +lemma correctedChain_ptxt : (correctedChain scheme q).usageCount .ptxt = 2 := by cc_usage rfl diff --git a/src/Examples/DSL/AEAD.lean b/src/Examples/DSL/AEAD.lean index 825ae47..4f07f2f 100644 --- a/src/Examples/DSL/AEAD.lean +++ b/src/Examples/DSL/AEAD.lean @@ -65,7 +65,7 @@ system AESPMAC ≔ PMAC authenticationBytes • AES system AuthenticatedEncryption ≔ EncryptThenMAC • (AESCTR ∥ AESPMAC) /-- The combined converter uses two independently keyed AES resources. -/ -theorem authenticatedEncryption_eq (q : ℕ) : +lemma authenticatedEncryption_eq (q : ℕ) : AuthenticatedEncryption (budget := q) = (EncryptThenMAC ≫ (CTR (2 ^ 36) ⊗ₘ PMAC authenticationBytes)) • (AES ∥ AES) := by unfold AuthenticatedEncryption AESCTR AESPMAC diff --git a/src/Examples/DSL/AEADTests.lean b/src/Examples/DSL/AEADTests.lean index 12c5f7b..e2aeb2f 100644 --- a/src/Examples/DSL/AEADTests.lean +++ b/src/Examples/DSL/AEADTests.lean @@ -19,13 +19,13 @@ namespace DSLExamples.Authenticated open Commons DSLExamples.Cipher /-- Each invocation makes at least one inside call. -/ -theorem bound_pos : 0 < EncryptThenMAC.bound := +lemma bound_pos : 0 < EncryptThenMAC.bound := EncryptThenMAC.bound_spec none AEAD.Port.encrypt (0, ⟨[], by norm_num⟩, ⟨[], by norm_num⟩) [] ⟨.inl StreamCipher.Port.crypt, (0, ⟨[], by norm_num⟩)⟩ (Program.consistent_nil EncryptThenMAC.body none _ _) (by simp [EncryptThenMAC.body, callProg]) /-- Encryption calls CTR, tags the ciphertext, then returns the pair. -/ -theorem encrypt_transcript {q : ℕ} (hq : 1 ≤ q) (nonce : Nonce) +lemma encrypt_transcript {q : ℕ} (hq : 1 ≤ q) (nonce : Nonce) (ad message ciphertext : Message) (tag : Block) : (EncryptThenMAC (budget := q)).1 [(⟨⟨none, AEAD.Port.encrypt⟩, (nonce, ad, message)⟩, @@ -45,7 +45,7 @@ theorem encrypt_transcript {q : ℕ} (hq : 1 ≤ q) (nonce : Nonce) Program.emit, EncryptThenMAC.body, callProg, returnProg, outsideInputs, splitIn, hq] /-- A tag that verifies permits exactly the requested decryption call. -/ -theorem decrypt_transcript {q : ℕ} (hq : 1 ≤ q) (nonce : Nonce) +lemma decrypt_transcript {q : ℕ} (hq : 1 ≤ q) (nonce : Nonce) (ad ciphertext message : Message) (tag : Block) : (EncryptThenMAC (budget := q)).1 [(⟨⟨none, AEAD.Port.decrypt⟩, (nonce, ad, ciphertext, tag)⟩, @@ -65,7 +65,7 @@ theorem decrypt_transcript {q : ℕ} (hq : 1 ≤ q) (nonce : Nonce) Program.emit, EncryptThenMAC.body, callProg, returnProg, outsideInputs, splitIn, hq] /-- A tag that does not verify returns failure without querying the cipher. -/ -theorem decrypt_rejects {q : ℕ} (hq : 1 ≤ q) (nonce : Nonce) (ad ciphertext : Message) +lemma decrypt_rejects {q : ℕ} (hq : 1 ≤ q) (nonce : Nonce) (ad ciphertext : Message) (tag : Block) : (EncryptThenMAC (budget := q)).1 [(⟨⟨none, AEAD.Port.decrypt⟩, (nonce, ad, ciphertext, tag)⟩, @@ -83,13 +83,13 @@ theorem decrypt_rejects {q : ℕ} (hq : 1 ≤ q) (nonce : Nonce) (ad ciphertext Program.emit, EncryptThenMAC.body, callProg, returnProg, outsideInputs, splitIn, hq] /-- A message needs at most `2³²` counter blocks, so the 32-bit counter does not wrap. -/ -theorem blockCount_le (message : Message) : CTR.blockCount message.val.length ≤ 2 ^ 32 := by +lemma blockCount_le (message : Message) : CTR.blockCount message.val.length ≤ 2 ^ 32 := by have hm := message.property simp only [CTR.blockCount] omega /-- No input to the authenticator reaches PMAC's oversized-message case. -/ -theorem authenticationBytes_length (nonce : Nonce) (ad ciphertext : Message) : +lemma authenticationBytes_length (nonce : Nonce) (ad ciphertext : Message) : (authenticationBytes (nonce, ad, ciphertext)).length ≤ 16 * 2 ^ 128 := by have ha := ad.property have hc := ciphertext.property @@ -117,7 +117,7 @@ def aeadDecrypt (encryptionKey authenticationKey : AES.Key .aes256) (nonce : Non else none /-- **Decryption inverts encryption.** -/ -theorem aeadDecrypt_aeadEncrypt (encryptionKey authenticationKey : AES.Key .aes256) +lemma aeadDecrypt_aeadEncrypt (encryptionKey authenticationKey : AES.Key .aes256) (nonce : Nonce) (ad message : Message) : let encrypted := aeadEncrypt encryptionKey authenticationKey nonce ad message aeadDecrypt encryptionKey authenticationKey nonce ad encrypted.1 encrypted.2 = diff --git a/src/Examples/DSL/AES.lean b/src/Examples/DSL/AES.lean index 3a81ead..49da64e 100644 --- a/src/Examples/DSL/AES.lean +++ b/src/Examples/DSL/AES.lean @@ -98,30 +98,30 @@ noncomputable def WhitenedMaskedAES (mask : Block) (q : Evaluation.Port → ℕ) noncomputable example (q : ℕ) : Interface.Resource (Authentication (Bool × Block × Block) q) := CBCMAC (fun (long, first, second) => if long then [first, second] else [first]) -theorem composedAES_eq (mask : Block) (q : ℕ) : +lemma composedAES_eq (mask : Block) (q : ℕ) : ComposedAES mask (budget := q) = Whitening mask • (Twice • AES) := by unfold ComposedAES cc_normalize -theorem parallelAES_eq (q : ℕ) : ParallelAES (budget := q) = DoubleAES ∥ DoubleAES := by +lemma parallelAES_eq (q : ℕ) : ParallelAES (budget := q) = DoubleAES ∥ DoubleAES := by unfold ParallelAES DoubleAES cc_normalize -theorem cbc_nonexpanding (blockForm : M → List Block) {q : ℕ} +lemma cbc_nonexpanding (blockForm : M → List Block) {q : ℕ} (R S : Interface.Resource (Evaluation Block Block (CBC.bound blockForm * q))) : Δ (CBC blockForm • R) (CBC blockForm • S) ≤ Δ R S := by cc_nonexpand /-- Parallel components keep their own alphabets: whitening AES beside an unrelated resource leaves that resource unchanged. -/ -theorem whitening_beside_switch (mask : Block) (q n : ℕ) : +lemma whitening_beside_switch (mask : Block) (q n : ℕ) : (Whitening mask (budget := q) ⊗ₘ 𝟙 (Control n)) • (AES ∥ Switch) = (Whitening mask • AES) ∥ Switch := by cc_normalize /-- A two-step hybrid: a bound on distinguishing AES from an ideal block cipher `R`, and a bound on the ideal system, give a bound on the real system. -/ -theorem aes_hybrid {A : Interface} {q : ℕ} (α : A ⟶ Evaluation Block Block q) +lemma aes_hybrid {A : Interface} {q : ℕ} (α : A ⟶ Evaluation Block Block q) (R : Interface.Resource (Evaluation Block Block q)) (V : Interface.Resource A) (ε δ : ENNReal) (aesBound : Δ AES R ≤ ε) (idealBound : Δ (α • R) V ≤ δ) : Δ (α • AES) V ≤ ε + δ := by diff --git a/src/Examples/Games.lean b/src/Examples/Games.lean index 2254fdd..0896dd6 100644 --- a/src/Examples/Games.lean +++ b/src/Examples/Games.lean @@ -151,11 +151,11 @@ noncomputable def collision : Interface.Game (AE.perPort M C q) := (hybrid_visible scheme q) /-- The visible resource of the collision game is the hybrid. -/ -theorem collision_visible : DistinctionGames.visible (collision scheme q) = Hybrid scheme q := +lemma collision_visible : DistinctionGames.visible (collision scheme q) = Hybrid scheme q := Interface.Game.visible_ofPDG _ _ _ /-- The collision game is conditionally equivalent to the ideal system. -/ -theorem collision_conditionallyEquivalent : +lemma collision_conditionallyEquivalent : DistinctionGames.ConditionallyEquivalent (collision scheme q) (AE.Ideal.perPort M C (budget := q) • Encryption.Real.perPort scheme : Interface.Resource (AE.perPort M C q)) := diff --git a/src/Examples/Substitution.lean b/src/Examples/Substitution.lean index bf3d1d7..78ef941 100644 --- a/src/Examples/Substitution.lean +++ b/src/Examples/Substitution.lean @@ -30,7 +30,7 @@ open SystemAlgebra SystemAlgebra.Substitution open scoped SystemAlgebra /-- Constant converters supply the diagonal of the unrestricted converter class. -/ -theorem unrestricted_diagonal {B : Interface} (left right : Interface.Resource B) +lemma unrestricted_diagonal {B : Interface} (left right : Interface.Resource B) (A : Interface) (resource : Interface.Resource A) : ∃ transformation ∈ (Set.univ : Set (A ⟶ B)), transformation • left = resource ∧ transformation • right = resource := diff --git a/src/Probability/Counting.lean b/src/Probability/Counting.lean index 6498ea8..01dc958 100644 --- a/src/Probability/Counting.lean +++ b/src/Probability/Counting.lean @@ -44,7 +44,7 @@ subset. This is the shared finite-set function-fiber count used by transcript normalization arguments. -/ -theorem card_function_fiber_finset {X Y : Type*} [Fintype X] [DecidableEq X] +lemma card_function_fiber_finset {X Y : Type*} [Fintype X] [DecidableEq X] [Fintype Y] [DecidableEq Y] (S : Finset X) (g : S → Y) : (Finset.univ.filter (fun f : X → Y => ∀ x : S, f x.1 = g x)).card = Fintype.card Y ^ (Fintype.card X - S.card) := by @@ -72,7 +72,7 @@ theorem card_function_fiber_finset {X Y : Type*} [Fintype X] [DecidableEq X] /-- The number of functions matching a prescribed output tuple on an injective input tuple is `|Y|^(|X|-q)`. -/ -theorem card_function_fiber_multipoint {X Y : Type*} +lemma card_function_fiber_multipoint {X Y : Type*} [Fintype X] [DecidableEq X] [Fintype Y] [DecidableEq Y] {q : ℕ} (xs : Fin q → X) (ys : Fin q → Y) (hxs : Function.Injective xs) : @@ -123,7 +123,7 @@ theorem card_function_fiber_multipoint {X Y : Type*} /-- **The fiber of a uniform random function over a prescribed value tuple at distinct points**, at an arbitrary finite index type: `card_function_fiber_multipoint` transported along `Fintype.equivFin`. -/ -theorem card_function_fiber_index {X Y ι : Type*} [Fintype X] [DecidableEq X] +lemma card_function_fiber_index {X Y ι : Type*} [Fintype X] [DecidableEq X] [Fintype Y] [DecidableEq Y] [Fintype ι] (xs : ι → X) (ys : ι → Y) (hxs : Function.Injective xs) : ((Finset.univ : Finset (X → Y)).filter @@ -151,7 +151,7 @@ distinct points are uniform.** Pushing the uniform law on `𝒳 → 𝒴` forwa along evaluation at an injective family of points is the uniform law on value tuples: this is independence of the values at distinct points, in the form this carrier can state it. -/ -theorem fTransform_eval_uniform_eq_uniform {X Y ι : Type*} [Fintype X] [DecidableEq X] +lemma fTransform_eval_uniform_eq_uniform {X Y ι : Type*} [Fintype X] [DecidableEq X] [Fintype Y] [DecidableEq Y] [Nonempty Y] [Fintype ι] [DecidableEq ι] (xs : ι → X) (hxs : Function.Injective xs) : Distribution.fTransform (fun f : X → Y => fun i => f (xs i)) @@ -169,7 +169,7 @@ theorem fTransform_eval_uniform_eq_uniform {X Y ι : Type*} [Fintype X] [Decidab points**: `(1/|𝒴|)^{|ι|}`, whatever the tuple. The mass reading of `fTransform_eval_uniform_eq_uniform`, and the form a transcript-law computation consumes. -/ -theorem uniform_mass_eval_eq {X Y ι : Type*} [Fintype X] [DecidableEq X] +lemma uniform_mass_eval_eq {X Y ι : Type*} [Fintype X] [DecidableEq X] [Fintype Y] [DecidableEq Y] [Nonempty Y] [Fintype ι] [DecidableEq ι] (xs : ι → X) (hxs : Function.Injective xs) (ys : ι → Y) : (Distribution.uniform (X → Y)).mass (fun f => (fun i => f (xs i)) = ys) @@ -195,7 +195,7 @@ def walkSite {ι X : Type*} (par : ι → Option ι) (g : ι → X → X) (x₀ on the very outputs `f` produced, and it reproduces `f`'s own site inputs. This needs no hypothesis on the walk at all — it is the recursion read outwards. -/ -theorem walkSite_of_eval {ι X : Type*} +lemma walkSite_of_eval {ι X : Type*} (par : ι → Option ι) (g : ι → X → X) (x₀ : X) (inp : (X → X) → ι → X) (hinp : ∀ f t, inp f t = g t ((par t).elim x₀ (fun h => f (inp f h)))) @@ -210,7 +210,7 @@ answers `y t` at every lazily replayed site input, then `f`'s own site inputs *are* the replayed ones. The converse direction of `walkSite_of_eval`, and the one that needs the parent relation to be well-founded — supplied here as a `rank` that strictly decreases towards the parent. -/ -theorem eq_walkSite_of_eval_eq {ι X : Type*} +lemma eq_walkSite_of_eval_eq {ι X : Type*} (par : ι → Option ι) (g : ι → X → X) (x₀ : X) (rank : ι → ℕ) (hrank : ∀ t h, par t = some h → rank h < rank t) (inp : (X → X) → ι → X) @@ -246,7 +246,7 @@ This is the lazy-sampling statement. It is false without the repeat-freeness hypothesis: at a tuple whose replay repeats an input the two directions of `walkSite_of_eval` still pin the fiber, but the fiber is the one of a *smaller* set of distinct evaluation points, so its mass is larger (or zero). -/ -theorem uniform_mass_walk_eval_eq {ι X : Type*} [Fintype ι] [DecidableEq ι] +lemma uniform_mass_walk_eval_eq {ι X : Type*} [Fintype ι] [DecidableEq ι] [Fintype X] [DecidableEq X] [Nonempty X] (par : ι → Option ι) (g : ι → X → X) (x₀ : X) (rank : ι → ℕ) (hrank : ∀ t h, par t = some h → rank h < rank t) @@ -275,7 +275,7 @@ worlds.** The probability that a uniform random function drives the walk without a repeat equals the probability that `|ι|` independent uniform draws replay it without a repeat. Only the repeat-free region transports — which is enough, because the birthday argument takes the complement afterwards. -/ -theorem uniform_mass_walk_injective_eq {ι X : Type*} [Fintype ι] [DecidableEq ι] +lemma uniform_mass_walk_injective_eq {ι X : Type*} [Fintype ι] [DecidableEq ι] [Fintype X] [DecidableEq X] [Nonempty X] (par : ι → Option ι) (g : ι → X → X) (x₀ : X) (rank : ι → ℕ) (hrank : ∀ t h, par t = some h → rank h < rank t) @@ -311,7 +311,7 @@ probability is at most `1/|𝒳|`. This is the elementary counting behind every step of a birthday argument, in the form the walk consumes: `u` is the step at the site being added and `v` is the input already sitting at the site it might hit. -/ -theorem uniform_mass_coord_determined_le {ι X : Type*} [Fintype ι] [DecidableEq ι] +lemma uniform_mass_coord_determined_le {ι X : Type*} [Fintype ι] [DecidableEq ι] [Fintype X] [DecidableEq X] [Nonempty X] (c : ι) (u : X → X) (hu : Function.Injective u) (v : (ι → X) → X) (hv : ∀ y z : ι → X, (∀ i, i ≠ c → y i = z i) → v y = v z) : @@ -364,7 +364,7 @@ all. Otherwise one of the two reads a state that the other does not, and `uniform_mass_coord_determined_le` charges the step `1/|𝒳|`; note this runs in *either* direction, so a deterministic site colliding with a randomized one is charged just as a continuation step is. -/ -theorem uniform_mass_walkSite_eq_le {ι X : Type*} [Fintype ι] [DecidableEq ι] +lemma uniform_mass_walkSite_eq_le {ι X : Type*} [Fintype ι] [DecidableEq ι] [Fintype X] [DecidableEq X] [Nonempty X] (par : ι → Option ι) (g : ι → X → X) (x₀ : X) (hg : ∀ t, Function.Injective (g t)) @@ -415,7 +415,7 @@ costs `|s|/|𝒳|`. The induction is on the *set of sites*, not on a global statement, because "repeat-free so far" is what makes the next step's charge legitimate; the telescoping `∑_{k<|s|} k/|𝒳|` is the birthday bound's arithmetic. -/ -theorem uniform_mass_walkSite_not_injOn_le {ι X : Type*} [Fintype ι] [DecidableEq ι] +lemma uniform_mass_walkSite_not_injOn_le {ι X : Type*} [Fintype ι] [DecidableEq ι] [Fintype X] [DecidableEq X] [Nonempty X] (par : ι → Option ι) (g : ι → X → X) (x₀ : X) (hg : ∀ t, Function.Injective (g t)) @@ -519,13 +519,13 @@ def multiShift {ι D A : Type*} [Fintype ι] [DecidableEq D] [AddCommMonoid A] (u : ι → D) (δ : ι → A) (f : D → A) : D → A := fun x => f x + ∑ s, if u s = x then δ s else 0 -theorem multiShift_apply_of_ne {ι D A : Type*} [Fintype ι] [DecidableEq D] +lemma multiShift_apply_of_ne {ι D A : Type*} [Fintype ι] [DecidableEq D] [AddCommMonoid A] {u : ι → D} (δ : ι → A) (f : D → A) {x : D} (h : ∀ s, u s ≠ x) : multiShift u δ f x = f x := by rw [multiShift, Finset.sum_eq_zero fun s _ => if_neg (h s), add_zero] -theorem multiShift_apply_site {ι D A : Type*} [Fintype ι] [DecidableEq D] +lemma multiShift_apply_site {ι D A : Type*} [Fintype ι] [DecidableEq D] [AddCommMonoid A] {u : ι → D} (δ : ι → A) (f : D → A) (hu : Function.Injective u) (s₀ : ι) : multiShift u δ f (u s₀) = f (u s₀) + δ s₀ := by @@ -534,13 +534,13 @@ theorem multiShift_apply_site {ι D A : Type*} [Fintype ι] [DecidableEq D] rw [Finset.sum_eq_single s₀ (fun s _ hs => if_neg fun hc => hs (hu hc)) (fun hns => absurd (Finset.mem_univ s₀) hns), if_pos rfl] -theorem multiShift_zero {ι D A : Type*} [Fintype ι] [DecidableEq D] +lemma multiShift_zero {ι D A : Type*} [Fintype ι] [DecidableEq D] [AddCommMonoid A] (u : ι → D) (f : D → A) : multiShift u 0 f = f := by funext x; simp [multiShift] /-- Shifts over the same site family compose additively. -/ -theorem multiShift_multiShift {ι D A : Type*} [Fintype ι] [DecidableEq D] +lemma multiShift_multiShift {ι D A : Type*} [Fintype ι] [DecidableEq D] [AddCommMonoid A] (u : ι → D) (δ δ' : ι → A) (f : D → A) : multiShift u δ' (multiShift u δ f) = multiShift u (δ + δ') f := by funext x @@ -554,7 +554,7 @@ theorem multiShift_multiShift {ι D A : Type*} [Fintype ι] [DecidableEq D] on a finite set `G` makes every `φ`-fiber the same size: `|fiber| · |A| = |G|`. This is the shared counting principle behind re-randomisation arguments (e.g. the CBC-MAC's joint-MAC count and its birthday per-pair count). -/ -theorem card_filter_shift {F A : Type*} [Fintype F] [DecidableEq F] +lemma card_filter_shift {F A : Type*} [Fintype F] [DecidableEq F] [AddCommGroup A] [Fintype A] [DecidableEq A] (G : Finset F) (φ : F → A) (act : A → F → F) (hmem : ∀ δ, ∀ f ∈ G, act δ f ∈ G) @@ -590,7 +590,7 @@ theorem card_filter_shift {F A : Type*} [Fintype F] [DecidableEq F] /-- **Predicate form of `card_filter_shift`** over `univ`: a free, `φ`-equivariant `A`-action on the `Good` subtype balances the `φ`-fibers within it. Phrased on the predicate `Good` so consumers avoid `Finset`-membership plumbing. -/ -theorem card_filter_shift_univ {F A : Type*} [Fintype F] [DecidableEq F] +lemma card_filter_shift_univ {F A : Type*} [Fintype F] [DecidableEq F] [AddCommGroup A] [Fintype A] [DecidableEq A] (Good : F → Prop) [DecidablePred Good] (φ : F → A) (act : A → F → F) (hmem : ∀ δ f, Good f → Good (act δ f)) diff --git a/src/Probability/Coupling.lean b/src/Probability/Coupling.lean index 30bf299..fdb768d 100644 --- a/src/Probability/Coupling.lean +++ b/src/Probability/Coupling.lean @@ -52,14 +52,14 @@ pushforward (`IsCoupling`'s own clause), and a pushforward of a non-negative law is non-negative, so the honesty hypothesis that accompanies every coupling statement is inherited by the two laws being coupled — it never has to be assumed twice. -/ -theorem IsCoupling.nonNeg_left {A B : Type*} {J : Distribution (A × B)} +lemma IsCoupling.nonNeg_left {A B : Type*} {J : Distribution (A × B)} {X : Distribution A} {Y : Distribution B} (hJ : IsCoupling J X Y) (hnn : ∀ p, 0 ≤ J p) : X.NonNeg := hJ.1 ▸ NonNeg.fTransform hnn Prod.fst /-- **An honest coupling has honest marginals**, right slot (`IsCoupling.nonNeg_left` at the second projection). -/ -theorem IsCoupling.nonNeg_right {A B : Type*} {J : Distribution (A × B)} +lemma IsCoupling.nonNeg_right {A B : Type*} {J : Distribution (A × B)} {X : Distribution A} {Y : Distribution B} (hJ : IsCoupling J X Y) (hnn : ∀ p, 0 ≤ J p) : Y.NonNeg := hJ.2 ▸ NonNeg.fTransform hnn Prod.snd @@ -77,21 +77,21 @@ def offDiagonalMass {A : Type*} (J : Distribution (A × A)) : ℝ := /-- The disagreement mass as a filtered sum over **any** finite set containing the support. Decidability is an explicit binder, per the decidability policy of `Probability.Distribution`. -/ -theorem offDiagonalMass_eq_sum_filter {A : Type*} (J : Distribution (A × A)) +lemma offDiagonalMass_eq_sum_filter {A : Type*} (J : Distribution (A × A)) {s : Finset (A × A)} (hs : J.support ⊆ s) [DecidablePred fun p : A × A => p.1 ≠ p.2] : offDiagonalMass J = ∑ p ∈ s.filter (fun p => p.1 ≠ p.2), J p := mass_eq_sum_of_support_subset J hs _ /-- An honest joint law has non-negative disagreement mass. -/ -theorem offDiagonalMass_nonneg {A : Type*} {J : Distribution (A × A)} +lemma offDiagonalMass_nonneg {A : Type*} {J : Distribution (A × A)} (hnn : ∀ p, 0 ≤ J p) : 0 ≤ offDiagonalMass J := NonNeg.mass_nonneg hnn _ /-- A joint law supported entirely off the diagonal disagrees with probability its own total weight. This is how the transport half of an optimal coupling is evaluated: it never charges a pair `(a, a)`. -/ -theorem offDiagonalMass_eq_weight_of_forall_ne {A : Type*} +lemma offDiagonalMass_eq_weight_of_forall_ne {A : Type*} (J : Distribution (A × A)) (h : ∀ p ∈ J.support, p.1 ≠ p.2) : offDiagonalMass J = J.weight := by classical @@ -128,12 +128,12 @@ variable {A : Type*} {X Y : Distribution A} /-- The transported residual of `Y` against `X` is the negative part of the same difference — the two residuals are the Jordan split of `X − Y`, which is why they never charge a point together. -/ -theorem posPart_sub_comm : (Y - X)⁺ = (X - Y)⁻ := by +lemma posPart_sub_comm : (Y - X)⁺ = (X - Y)⁻ := by rw [posPart_def, negPart_def, neg_sub] /-- The transport plan never charges the diagonal: its two factors are the two halves of a Jordan split, and those have disjoint supports. -/ -theorem forall_ne_of_mem_support_prod_posPart +lemma forall_ne_of_mem_support_prod_posPart {p : A × A} (hp : p ∈ (prod ((X - Y)⁺) ((Y - X)⁺)).support) : p.1 ≠ p.2 := by intro hpe refine Finsupp.mem_support_iff.mp hp ?_ @@ -145,7 +145,7 @@ theorem forall_ne_of_mem_support_prod_posPart the first by definition of `δ` as the weight of a positive part, the second by the equal-weight symmetry of `δ`. This is what makes the normalized product a transport plan of exactly the disagreement mass. -/ -theorem weight_posPart_sub_eq_statDist (hw : X.weight = Y.weight) : +lemma weight_posPart_sub_eq_statDist (hw : X.weight = Y.weight) : ((X - Y)⁺).weight = statDist X Y ∧ ((Y - X)⁺).weight = statDist X Y := ⟨(statDist_eq_weight_posPart X Y).symm, by rw [← statDist_eq_weight_posPart Y X, ← statDist_symm_of_eq_weight X Y hw]⟩ @@ -153,7 +153,7 @@ theorem weight_posPart_sub_eq_statDist (hw : X.weight = Y.weight) : /-- The optimal joint law is honest whenever its marginals are: the diagonal carries a pointwise meet of non-negative laws, and the transport term is a non-negative multiple of a product of positive parts. -/ -theorem optimalJoint_nonNeg (hX : X.NonNeg) (hY : Y.NonNeg) : +lemma optimalJoint_nonNeg (hX : X.NonNeg) (hY : Y.NonNeg) : (optimalJoint X Y).NonNeg := by have hinf : (X ⊓ Y).NonNeg := nonNeg_iff_zero_le.mpr (le_inf (nonNeg_iff_zero_le.mp hX) (nonNeg_iff_zero_le.mp hY)) @@ -170,7 +170,7 @@ term as its own residual, rescaled by `δ(X, Y)⁻¹ · δ(X, Y) = 1`; the meet the one-sided excess rebuilds the marginal (`inf_add_posPart_sub`). At `δ(X, Y) = 0` the rescaling is `0`, but so is the residual — a non-negative law of weight zero is zero — so the identity holds there too. -/ -theorem isCoupling_optimalJoint (hw : X.weight = Y.weight) : +lemma isCoupling_optimalJoint (hw : X.weight = Y.weight) : IsCoupling (optimalJoint X Y) X Y := by obtain ⟨hP, hQ⟩ := weight_posPart_sub_eq_statDist hw -- Rescaling by `δ⁻¹` undoes the residual weight, `δ = 0` included. @@ -199,7 +199,7 @@ The diagonal term contributes nothing — it is supported on `{(a, a)}` — and the transport term contributes its whole weight, since it never charges the diagonal; that weight is `δ(X, Y)⁻¹ · δ(X, Y) · δ(X, Y) = δ(X, Y)`, and at `δ(X, Y) = 0` both sides are `0`. -/ -theorem offDiagonalMass_optimalJoint (hw : X.weight = Y.weight) : +lemma offDiagonalMass_optimalJoint (hw : X.weight = Y.weight) : offDiagonalMass (optimalJoint X Y) = statDist X Y := by obtain ⟨hP, hQ⟩ := weight_posPart_sub_eq_statDist hw have hdiag : @@ -353,14 +353,14 @@ def Coupling.prDisagree {X Y : Distribution A} (C : Coupling X Y) : ℝ := omit [Fintype A] [DecidableEq A] in /-- The bundled joint law is a coupling in the sense of `Distribution.IsCoupling`. -/ -theorem Coupling.isCoupling_joint {X Y : Distribution A} (C : Coupling X Y) : +lemma Coupling.isCoupling_joint {X Y : Distribution A} (C : Coupling X Y) : Distribution.IsCoupling C.joint X Y := ⟨C.marginal_fst, C.marginal_snd⟩ /-- The bundled disagreement probability is the general disagreement mass: the sum over the whole (finite) carrier and the sum over the support agree, since the summands off the support vanish. -/ -theorem Coupling.prDisagree_eq_offDiagonalMass {X Y : Distribution A} +lemma Coupling.prDisagree_eq_offDiagonalMass {X Y : Distribution A} (C : Coupling X Y) : C.prDisagree = Distribution.offDiagonalMass C.joint := by classical @@ -368,7 +368,7 @@ theorem Coupling.prDisagree_eq_offDiagonalMass {X Y : Distribution A} Distribution.offDiagonalMass_eq_sum_filter C.joint (Finset.subset_univ _)] /-- Disagreement mass of an honest coupling is non-negative. -/ -theorem Coupling.prDisagree_nonneg {X Y : Distribution A} +lemma Coupling.prDisagree_nonneg {X Y : Distribution A} (C : Coupling X Y) : 0 ≤ C.prDisagree := by unfold Coupling.prDisagree exact Finset.sum_nonneg fun p _ ↦ C.nonneg p @@ -404,7 +404,7 @@ def Coupling.fTransform {B : Type*} [Fintype B] [Nonempty B] [DecidableEq B] /-- Injective deterministic maps preserve the disagreement probability of a pushed-forward coupling. -/ -theorem Coupling.prDisagree_fTransform_of_injective +lemma Coupling.prDisagree_fTransform_of_injective {B : Type*} [Fintype B] [Nonempty B] [DecidableEq B] [Nonempty A] {X Y : Distribution A} (C : Coupling X Y) (f : A → B) (hf : Function.Injective f) : @@ -456,7 +456,7 @@ noncomputable def jointProfileList {I CH : Type*} [DecidableEq I] fTransform (fun cp : CH × (I → CH) => Function.update cp.2 i cp.1) (prod (D i) (jointProfileList u d D l)) -theorem jointProfileList_weight {I CH : Type*} [DecidableEq I] +lemma jointProfileList_weight {I CH : Type*} [DecidableEq I] (u : ℝ) (d : CH) (D : I → Distribution CH) : ∀ l : List I, (∀ j ∈ l, (D j).weight = u) → (jointProfileList u d D l).weight = u := by @@ -472,7 +472,7 @@ theorem jointProfileList_weight {I CH : Type*} [DecidableEq I] · simp · rw [← mul_assoc, inv_mul_cancel₀ hu, one_mul] -theorem jointProfileList_marginal {I CH : Type*} [DecidableEq I] +lemma jointProfileList_marginal {I CH : Type*} [DecidableEq I] (u : ℝ) (d : CH) (D : I → Distribution CH) : ∀ l : List I, (∀ j ∈ l, (D j).NonNeg) → (∀ j ∈ l, (D j).weight = u) → ∀ i ∈ l, @@ -521,14 +521,14 @@ noncomputable def jointProfile {I CH : Type*} [DecidableEq I] Distribution (I → CH) := jointProfileList u d D C.toList -theorem jointProfile_weight {I CH : Type*} [DecidableEq I] +lemma jointProfile_weight {I CH : Type*} [DecidableEq I] (u : ℝ) (d : CH) (C : Finset I) (D : I → Distribution CH) (hw : ∀ j ∈ C, (D j).weight = u) : (jointProfile u d C D).weight = u := jointProfileList_weight u d D C.toList fun j hj => hw j (Finset.mem_toList.mp hj) -theorem jointProfile_marginal {I CH : Type*} [DecidableEq I] +lemma jointProfile_marginal {I CH : Type*} [DecidableEq I] (u : ℝ) (d : CH) (C : Finset I) (D : I → Distribution CH) (hDnn : ∀ j ∈ C, (D j).NonNeg) (hw : ∀ j ∈ C, (D j).weight = u) {i : I} (hi : i ∈ C) : @@ -538,7 +538,7 @@ theorem jointProfile_marginal {I CH : Type*} [DecidableEq I] (fun j hj => hw j (Finset.mem_toList.mp hj)) i (Finset.mem_toList.mpr hi) -theorem jointProfileList_nonNeg {I CH : Type*} [DecidableEq I] +lemma jointProfileList_nonNeg {I CH : Type*} [DecidableEq I] {u : ℝ} (hu : 0 ≤ u) (d : CH) (D : I → Distribution CH) : ∀ l : List I, (∀ j ∈ l, (D j).NonNeg) → (jointProfileList u d D l).NonNeg := by @@ -553,7 +553,7 @@ theorem jointProfileList_nonNeg {I CH : Type*} [DecidableEq I] exact (((hD j (by simp)).prod (ih fun k hk => hD k (by simp [hk]))).fTransform _) p -theorem jointProfile_nonNeg {I CH : Type*} [DecidableEq I] +lemma jointProfile_nonNeg {I CH : Type*} [DecidableEq I] {u : ℝ} (hu : 0 ≤ u) (d : CH) (C : Finset I) {D : I → Distribution CH} (hD : ∀ j ∈ C, (D j).NonNeg) : (jointProfile u d C D).NonNeg := jointProfileList_nonNeg hu d D C.toList @@ -561,7 +561,7 @@ theorem jointProfile_nonNeg {I CH : Type*} [DecidableEq I] /-- The joint never moves the inert value: a profile in its support takes the value `d` at every class outside the coupled list. -/ -theorem jointProfileList_support_default {I CH : Type*} +lemma jointProfileList_support_default {I CH : Type*} [DecidableEq I] (u : ℝ) (d : CH) (D : I → Distribution CH) : ∀ (l : List I) (p : I → CH), p ∈ (jointProfileList u d D l).support → ∀ i, i ∉ l → p i = d := by @@ -591,7 +591,7 @@ theorem jointProfileList_support_default {I CH : Type*} value untouched outside the coupled classes. This is the two-summand form the attainment construction consumes, where one summand is the shared component and the other the residual. -/ -theorem add_jointProfile_support_default {I CH : Type*} [DecidableEq I] +lemma add_jointProfile_support_default {I CH : Type*} [DecidableEq I] (u u' : ℝ) (d : CH) (C : Finset I) (E F : I → Distribution CH) : ∀ p ∈ (jointProfile u d C E + jointProfile u' d C F).support, ∀ i, i ∉ C → p i = d := by @@ -603,7 +603,7 @@ theorem add_jointProfile_support_default {I CH : Type*} [DecidableEq I] · exact jointProfileList_support_default u' d F C.toList p h i hi' /-- The class-`Finset` form of `jointProfileList_support_default`. -/ -theorem jointProfile_support_default {I CH : Type*} [DecidableEq I] +lemma jointProfile_support_default {I CH : Type*} [DecidableEq I] (u : ℝ) (d : CH) (C : Finset I) (D : I → Distribution CH) {p : I → CH} (hp : p ∈ (jointProfile u d C D).support) {i : I} (hi : i ∉ C) : p i = d := diff --git a/src/Probability/Distribution.lean b/src/Probability/Distribution.lean index ede7487..b4c7399 100644 --- a/src/Probability/Distribution.lean +++ b/src/Probability/Distribution.lean @@ -83,13 +83,13 @@ carry it as a predicate. -/ def NonNeg {A : Type*} (X : Distribution A) : Prop := ∀ a, 0 ≤ X a omit [Fintype A] [Nonempty A] in -theorem NonNeg.weight_nonneg {X : Distribution A} (hX : X.NonNeg) : 0 ≤ X.weight := +lemma NonNeg.weight_nonneg {X : Distribution A} (hX : X.NonNeg) : 0 ≤ X.weight := Finset.sum_nonneg fun a _ => hX a omit [Nonempty A] in /-- On a finite carrier, support-based weight is the ordinary sum over all points. (Needs `Fintype A` but not `Nonempty A` — the latter is a section-variable leak.) -/ -theorem weight_eq_sum (X : Distribution A) : +lemma weight_eq_sum (X : Distribution A) : X.weight = ∑ a : A, X a := by simpa [weight] using (Finsupp.sum_fintype (f := X) (g := fun _ w => w) (h := by intro _; rfl)) @@ -98,7 +98,7 @@ theorem weight_eq_sum (X : Distribution A) : points outside the support carry no mass. This is the `Fintype`-free companion of `weight_eq_sum`, and the form needed on carriers that are genuinely infinite (transcript spaces, system laws). -/ -theorem weight_eq_sum_of_support_subset {A : Type*} (X : Distribution A) +lemma weight_eq_sum_of_support_subset {A : Type*} (X : Distribution A) {s : Finset A} (hs : X.support ⊆ s) : X.weight = ∑ a ∈ s, X a := Finsupp.sum_of_support_subset X hs (fun _ w => w) (fun _ _ => rfl) @@ -110,14 +110,14 @@ def ofFiniteMassFunction (law : A → ℝ) : Distribution A := omit [Nonempty A] in @[simp] -theorem ofFiniteMassFunction_apply (law : A → ℝ) (a : A) : +lemma ofFiniteMassFunction_apply (law : A → ℝ) (a : A) : ofFiniteMassFunction law a = law a := by simp [ofFiniteMassFunction] omit [Nonempty A] in /-- The total weight of a finite mass function as a distribution is the sum of its masses over the carrier. -/ -theorem weight_ofFiniteMassFunction (law : A → ℝ) : +lemma weight_ofFiniteMassFunction (law : A → ℝ) : (ofFiniteMassFunction law).weight = ∑ a : A, law a := by simp [weight_eq_sum, ofFiniteMassFunction] @@ -135,14 +135,14 @@ class IsProbability (X : Distribution A) : Prop where omit [Fintype A] [Nonempty A] in /-- The probability capability supplies the underlying distribution predicate. -/ -theorem IsProbability.isProbDist (X : Distribution A) [IsProbability X] : X.isProbDist := +lemma IsProbability.isProbDist (X : Distribution A) [IsProbability X] : X.isProbDist := ⟨IsProbability.nonNeg, IsProbability.weight_eq_one⟩ omit [Fintype A] [Nonempty A] in -theorem isProbDist.nonNeg {X : Distribution A} (hX : X.isProbDist) : X.NonNeg := hX.1 +lemma isProbDist.nonNeg {X : Distribution A} (hX : X.isProbDist) : X.NonNeg := hX.1 omit [Fintype A] [Nonempty A] in -theorem isProbDist.weight_eq {X : Distribution A} (hX : X.isProbDist) : X.weight = 1 := +lemma isProbDist.weight_eq {X : Distribution A} (hX : X.isProbDist) : X.weight = 1 := hX.2 /-- Probability distributions are distributions with total mass one. -/ @@ -170,14 +170,14 @@ noncomputable def supportProbDist {A : Type*} (D : ProbDist A) : exact Finset.sum_attach D.val.support (fun a => D.val a)⟩ @[simp] -theorem supportProbDist_apply {A : Type*} (D : ProbDist A) +lemma supportProbDist_apply {A : Type*} (D : ProbDist A) (a : {a : A // a ∈ D.val.support}) : supportProbDist D a = D.val a.1 := by rfl omit [Fintype A] [Nonempty A] in /-- A unit point mass is a probability distribution. -/ -theorem isProbDist_single (a : A) : +lemma isProbDist_single (a : A) : isProbDist (Finsupp.single a (1 : ℝ) : Distribution A) := by constructor · intro b @@ -192,7 +192,7 @@ noncomputable def ProbDist.single (a : A) : ProbDist A := omit [Fintype A] [Nonempty A] in /-- A probability distribution has a sample. -/ -theorem ProbDist.nonempty (P : ProbDist A) : Nonempty A := by +lemma ProbDist.nonempty (P : ProbDist A) : Nonempty A := by by_contra hA rw [not_nonempty_iff] at hA have hw := P.2.2 @@ -219,7 +219,7 @@ noncomputable def mass (X : Distribution A) (P : A → Prop) : ℝ := omit [Fintype A] [Nonempty A] in /-- Event mass of a non-negative distribution is non-negative. -/ -theorem NonNeg.mass_nonneg {X : Distribution A} (hX : X.NonNeg) (P : A → Prop) : +lemma NonNeg.mass_nonneg {X : Distribution A} (hX : X.NonNeg) (P : A → Prop) : 0 ≤ X.mass P := Finset.sum_nonneg fun a _ => by by_cases h : P a <;> simp [h, hX a] @@ -228,7 +228,7 @@ omit [Fintype A] [Nonempty A] in /-- Event mass is additive in the distribution: `(X + Y)(P) = X(P) + Y(P)`. Signed layer, no `Fintype` — the companion of `weight_smul`/`mass_smul` (`Probability.Lift`) on the additive side. -/ -theorem mass_add (X Y : Distribution A) (P : A → Prop) : +lemma mass_add (X Y : Distribution A) (P : A → Prop) : (X + Y).mass P = X.mass P + Y.mass P := by classical unfold mass @@ -246,7 +246,7 @@ are genuinely infinite, and the companion of The decidability of `P` is an explicit binder, per this file's decidability policy: the statement contains a `Finset.filter`, so it must instantiate with the caller's ambient instance. -/ -theorem mass_eq_sum_of_support_subset (X : Distribution A) {s : Finset A} +lemma mass_eq_sum_of_support_subset (X : Distribution A) {s : Finset A} (hs : X.support ⊆ s) (P : A → Prop) [DecidablePred P] : X.mass P = ∑ a ∈ s.filter P, X a := by classical @@ -260,18 +260,18 @@ noncomputable def restrict {A : Type*} (X : Distribution A) (P : A → Prop) : D Finsupp.filter P X @[simp] -theorem restrict_apply {A : Type*} (X : Distribution A) (P : A → Prop) (a : A) : +lemma restrict_apply {A : Type*} (X : Distribution A) (P : A → Prop) (a : A) : X.restrict P a = if P a then X a else 0 := by simp [restrict, Finsupp.filter_apply] /-- Restriction preserves non-negativity. -/ -theorem NonNeg.restrict {A : Type*} {X : Distribution A} (hX : X.NonNeg) (P : A → Prop) : +lemma NonNeg.restrict {A : Type*} {X : Distribution A} (hX : X.NonNeg) (P : A → Prop) : (X.restrict P).NonNeg := fun a => by rw [restrict_apply] by_cases h : P a <;> simp [h, hX a] /-- The mass of `P` after restricting to `Q` is the mass of `P ∩ Q`. -/ -theorem mass_restrict {A : Type*} (X : Distribution A) (P Q : A → Prop) : +lemma mass_restrict {A : Type*} (X : Distribution A) (P Q : A → Prop) : (X.restrict Q).mass P = X.mass (fun a => P a ∧ Q a) := by unfold restrict mass Finsupp.sum simp only [Finsupp.support_filter, Finsupp.filter_apply] @@ -325,19 +325,19 @@ lemma single_restrict {A : Type*} (a : A) (w : ℝ) (P : A → Prop) : · simp [restrict, Finsupp.filter_single_of_neg _ h, h] -theorem mass_true {A : Type*} (X : Distribution A) : +lemma mass_true {A : Type*} (X : Distribution A) : X.mass (fun _ => True) = X.weight := by unfold mass weight simp /-- A pointwise-impossible event has zero mass. -/ -theorem mass_eq_zero_of_forall_not {A : Type*} (X : Distribution A) {P : A → Prop} +lemma mass_eq_zero_of_forall_not {A : Type*} (X : Distribution A) {P : A → Prop} (h : ∀ a, ¬ P a) : X.mass P = 0 := by unfold mass Finsupp.sum exact Finset.sum_eq_zero fun a _ => if_neg (h a) /-- Mass depends only on the event up to logical equivalence. -/ -theorem mass_congr {A : Type*} (X : Distribution A) {P Q : A → Prop} (h : ∀ a, P a ↔ Q a) : +lemma mass_congr {A : Type*} (X : Distribution A) {P Q : A → Prop} (h : ∀ a, P a ↔ Q a) : X.mass P = X.mass Q := by unfold mass congr 1 @@ -346,7 +346,7 @@ theorem mass_congr {A : Type*} (X : Distribution A) {P Q : A → Prop} (h : ∀ /-- `mass_congr` with the equivalence required only on the support — mass sums over the support, so that is all it reads. -/ -theorem mass_congr_of_support {A : Type*} (X : Distribution A) {P Q : A → Prop} +lemma mass_congr_of_support {A : Type*} (X : Distribution A) {P Q : A → Prop} (h : ∀ a ∈ X.support, (P a ↔ Q a)) : X.mass P = X.mass Q := by unfold mass refine Finsupp.sum_congr fun a ha => ?_ @@ -354,7 +354,7 @@ theorem mass_congr_of_support {A : Type*} (X : Distribution A) {P Q : A → Prop open scoped Classical in /-- An event and its complement partition the total mass: `X(P) + X(¬P) = |X|`. -/ -theorem mass_add_compl {A : Type*} (X : Distribution A) (P : A → Prop) : +lemma mass_add_compl {A : Type*} (X : Distribution A) (P : A → Prop) : X.mass P + X.mass (fun a => ¬ P a) = X.weight := by unfold mass weight Finsupp.sum rw [← Finset.sum_add_distrib] @@ -363,7 +363,7 @@ theorem mass_add_compl {A : Type*} (X : Distribution A) (P : A → Prop) : /-- **Splitting one event by another**: `X(Q) = X(P ∧ Q) + X(¬P ∧ Q)`. The relative form of `mass_add_compl`, which is the case `Q = True`. Signed layer: the pointwise indicator identity, summed. -/ -theorem mass_and_add_mass_not_and {A : Type*} (X : Distribution A) (P Q : A → Prop) : +lemma mass_and_add_mass_not_and {A : Type*} (X : Distribution A) (P Q : A → Prop) : X.mass (fun a => P a ∧ Q a) + X.mass (fun a => ¬ P a ∧ Q a) = X.mass Q := by classical simp only [Distribution.mass, Finsupp.sum] @@ -373,13 +373,13 @@ theorem mass_and_add_mass_not_and {A : Type*} (X : Distribution A) (P Q : A → /-- The mass of an event never exceeds the total mass of a non-negative distribution: `X(P) ≤ |X|`. -/ -theorem mass_le_weight {A : Type*} {X : Distribution A} (hX : X.NonNeg) (P : A → Prop) : +lemma mass_le_weight {A : Type*} {X : Distribution A} (hX : X.NonNeg) (P : A → Prop) : X.mass P ≤ X.weight := by rw [← mass_add_compl X P] exact le_add_of_nonneg_right (hX.mass_nonneg _) /-- Monotonicity of event mass: a weaker event carries at least as much mass. -/ -theorem mass_mono {A : Type*} {X : Distribution A} (hX : X.NonNeg) {P Q : A → Prop} +lemma mass_mono {A : Type*} {X : Distribution A} (hX : X.NonNeg) {P Q : A → Prop} (h : ∀ a, P a → Q a) : X.mass P ≤ X.mass Q := by classical simp only [Distribution.mass, Finsupp.sum] @@ -391,7 +391,7 @@ theorem mass_mono {A : Type*} {X : Distribution A} (hX : X.NonNeg) {P Q : A → /-- **A common part bounds the difference of masses**, one side: if `μ₁` has weight one and both `μ₁` and `μ₂` lie above `ν`, then `μ₁` exceeds `μ₂` on every event by at most the weight `μ₁` does not share with `ν`, `μ₁(P) − μ₂(P) ≤ 1 − |ν|`. -/ -theorem mass_sub_mass_le_of_le {A : Type*} {μ₁ μ₂ ν : Distribution A} (h₁ : μ₁.weight = 1) +lemma mass_sub_mass_le_of_le {A : Type*} {μ₁ μ₂ ν : Distribution A} (h₁ : μ₁.weight = 1) (hν₁ : ∀ a, ν a ≤ μ₁ a) (hν₂ : ∀ a, ν a ≤ μ₂ a) (P : A → Prop) : μ₁.mass P - μ₂.mass P ≤ 1 - ν.weight := by -- Plan. Each μ above ν splits as ν + (μ − ν), with μ − ν ≥ 0. So @@ -420,7 +420,7 @@ theorem mass_sub_mass_le_of_le {A : Type*} {μ₁ μ₂ ν : Distribution A} (h /-- **A common part bounds the difference of masses**: two laws of weight one that both lie above `ν` differ on every event by at most the weight they do not share with `ν`, `|μ₁(P) − μ₂(P)| ≤ 1 − |ν|`. -/ -theorem abs_mass_sub_le_of_le {A : Type*} {μ₁ μ₂ ν : Distribution A} (h₁ : μ₁.weight = 1) +lemma abs_mass_sub_le_of_le {A : Type*} {μ₁ μ₂ ν : Distribution A} (h₁ : μ₁.weight = 1) (h₂ : μ₂.weight = 1) (hν₁ : ∀ a, ν a ≤ μ₁ a) (hν₂ : ∀ a, ν a ≤ μ₂ a) (P : A → Prop) : |μ₁.mass P - μ₂.mass P| ≤ 1 - ν.weight := -- The one-sided bound, for μ₁ over μ₂ and for μ₂ over μ₁. @@ -432,7 +432,7 @@ signed-carrier form of `Finset.single_le_sum` for `Distribution.mass`. A support atom witnessing an event forces that event to carry positive mass, so an event of mass zero has no witness in the support. -/ -theorem apply_le_mass {A : Type*} {X : Distribution A} (hX : X.NonNeg) +lemma apply_le_mass {A : Type*} {X : Distribution A} (hX : X.NonNeg) {P : A → Prop} {a : A} (ha : P a) : X a ≤ X.mass P := by classical by_cases hsupport : a ∈ X.support @@ -446,7 +446,7 @@ theorem apply_le_mass {A : Type*} {X : Distribution A} (hX : X.NonNeg) /-- `mass_mono` with the implication required only on the support — mass is a support sum, so off-support behavior of the events is irrelevant. -/ -theorem mass_mono_on_support {A : Type*} {X : Distribution A} (hX : X.NonNeg) +lemma mass_mono_on_support {A : Type*} {X : Distribution A} (hX : X.NonNeg) {P Q : A → Prop} (h : ∀ a ∈ X.support, P a → Q a) : X.mass P ≤ X.mass Q := by classical @@ -457,7 +457,7 @@ theorem mass_mono_on_support {A : Type*} {X : Distribution A} (hX : X.NonNeg) · by_cases hQ : Q a <;> simp [hP, hQ, hX a] /-- Subadditivity over a disjunction — the two-event union bound. -/ -theorem mass_or_le {A : Type*} {X : Distribution A} (hX : X.NonNeg) (P Q : A → Prop) : +lemma mass_or_le {A : Type*} {X : Distribution A} (hX : X.NonNeg) (P Q : A → Prop) : X.mass (fun a => P a ∨ Q a) ≤ X.mass P + X.mass Q := by classical simp only [Distribution.mass, Finsupp.sum] @@ -477,7 +477,7 @@ theorem mass_or_le {A : Type*} {X : Distribution A} (hX : X.NonNeg) (P Q : A → simp [hpq.1, hpq.2] /-- The `Finset`-indexed union bound — `mass_or_le` iterated. -/ -theorem mass_exists_le {A ι : Type*} {X : Distribution A} (hX : X.NonNeg) (s : Finset ι) +lemma mass_exists_le {A ι : Type*} {X : Distribution A} (hX : X.NonNeg) (s : Finset ι) (P : ι → A → Prop) : X.mass (fun a => ∃ i ∈ s, P i a) ≤ ∑ i ∈ s, X.mass (P i) := by classical @@ -494,7 +494,7 @@ theorem mass_exists_le {A ι : Type*} {X : Distribution A} (hX : X.NonNeg) (s : linarith [ih] /-- Restricting to an event leaves exactly the mass of that event. -/ -theorem weight_restrict {A : Type*} (X : Distribution A) (P : A → Prop) : +lemma weight_restrict {A : Type*} (X : Distribution A) (P : A → Prop) : (X.restrict P).weight = X.mass P := by rw [← mass_true (X.restrict P), mass_restrict] simp @@ -555,7 +555,7 @@ def evalPred (X : Distribution A) (P : A → Prop) : ℝ := ∑ a ∈ Finset.univ.filter P, X a @[simp] -theorem evalPred_eq_evalSet (X : Distribution A) (P : A → Prop) : +lemma evalPred_eq_evalSet (X : Distribution A) (P : A → Prop) : X.evalPred P = X.evalSet (Finset.univ.filter P) := by rfl @@ -569,17 +569,17 @@ def uniform (A : Type*) [Fintype A] [Nonempty A] : Distribution A := /-! ### Uniform distribution lemmas -/ /-- Pointwise evaluation of the uniform distribution. -/ -theorem uniform_apply (a : A) : +lemma uniform_apply (a : A) : (uniform A) a = 1 / (Fintype.card A : ℝ) := by simp [uniform, Finsupp.equivFunOnFinite] /-- The uniform distribution is pointwise non-negative. -/ -theorem uniform_nonNeg : (uniform A).NonNeg := fun a => by +lemma uniform_nonNeg : (uniform A).NonNeg := fun a => by rw [uniform_apply] positivity /-- The uniform distribution has weight 1. -/ -theorem weight_uniform : +lemma weight_uniform : (uniform A).weight = 1 := by rw [weight_eq_sum] have h_card_pos : (0 : ℝ) < (Fintype.card A : ℝ) := @@ -589,7 +589,7 @@ theorem weight_uniform : exact_mod_cast h_card_pos.ne' /-- The uniform distribution is a probability distribution. -/ -theorem uniform_isProbDist : +lemma uniform_isProbDist : (uniform A).isProbDist := ⟨uniform_nonNeg, weight_uniform⟩ instance : IsProbability (uniform A) := ⟨uniform_nonNeg, weight_uniform⟩ @@ -617,7 +617,7 @@ def marginalAt {ι : Type*} {X : ι → Type*} /-- Pointwise form of `marginalAt`: the mass at `xj` is the mass of the fiber of product points whose `j`-th coordinate equals `xj`. -/ -theorem marginalAt_apply {ι : Type*} {X : ι → Type*} +lemma marginalAt_apply {ι : Type*} {X : ι → Type*} (F : Distribution ((i : ι) → X i)) (j : ι) (xj : X j) : marginalAt F j xj = F.mass (fun x => x j = xj) := by unfold marginalAt mass @@ -633,14 +633,14 @@ def fTransform (f : A → B) (X : Distribution A) : Distribution B := X.sum (fun a w => Finsupp.single (f a) w) /-- Pushforward composes. -/ -theorem fTransform_fTransform {A B C : Type*} +lemma fTransform_fTransform {A B C : Type*} (f : B → C) (g : A → B) (X : Distribution A) : fTransform f (fTransform g X) = fTransform (f ∘ g) X := by show Finsupp.mapDomain f (Finsupp.mapDomain g X) = Finsupp.mapDomain (f ∘ g) X exact (Finsupp.mapDomain_comp (v := X)).symm /-- Pointwise evaluation of a pushforward is the mass of the fiber. -/ -theorem fTransform_apply_eq_mass {A B : Type*} +lemma fTransform_apply_eq_mass {A B : Type*} (f : A → B) (X : Distribution A) (b : B) : fTransform f X b = X.mass (fun a => f a = b) := by unfold fTransform mass @@ -648,7 +648,7 @@ theorem fTransform_apply_eq_mass {A B : Type*} /-- Evaluating a pushforward at an image point of an injective map recovers the original mass. -/ -theorem fTransform_injective_apply {A B : Type*} +lemma fTransform_injective_apply {A B : Type*} (X : Distribution A) (f : A → B) (hf : Function.Injective f) (a : A) : fTransform f X (f a) = X a := by simp only [fTransform, Finsupp.sum, Finsupp.coe_finsetSum, Finset.sum_apply, @@ -661,7 +661,7 @@ theorem fTransform_injective_apply {A B : Type*} simp [Finsupp.notMem_support_iff.mp ha] /-- Evaluating a pushforward away from the image of the map gives zero mass. -/ -theorem fTransform_apply_of_forall_ne {A B : Type*} +lemma fTransform_apply_of_forall_ne {A B : Type*} (X : Distribution A) (f : A → B) (b : B) (h : ∀ a, f a ≠ b) : fTransform f X b = 0 := by simp only [fTransform, Finsupp.sum, Finsupp.coe_finsetSum, Finset.sum_apply, @@ -672,21 +672,21 @@ theorem fTransform_apply_of_forall_ne {A B : Type*} /-- Every support element of a pushforward has a support witness in the source distribution. -/ -theorem mem_support_fTransform {A B : Type*} (f : A → B) (X : Distribution A) {b : B} +lemma mem_support_fTransform {A B : Type*} (f : A → B) (X : Distribution A) {b : B} (hb : b ∈ (fTransform f X).support) : ∃ a ∈ X.support, f a = b := by classical have hsub : (fTransform f X).support ⊆ X.support.image f := Finsupp.mapDomain_support simpa [fTransform] using hsub hb /-- A weighted sum over a pushforward pulls the summand back. -/ -theorem sum_fTransform_mul {A B : Type*} (f : A → B) (X : Distribution A) (g : B → ℝ) : +lemma sum_fTransform_mul {A B : Type*} (f : A → B) (X : Distribution A) (g : B → ℝ) : (fTransform f X).sum (fun b w => w * g b) = X.sum (fun a w => w * g (f a)) := by classical unfold fTransform exact Finsupp.sum_mapDomain_index (fun _ => zero_mul _) (fun _ _ _ => add_mul _ _ _) /-- Event mass under a pushforward is event mass of the preimage. -/ -theorem mass_fTransform {A B : Type*} +lemma mass_fTransform {A B : Type*} (f : A → B) (X : Distribution A) (P : B → Prop) : (fTransform f X).mass P = X.mass (fun a => P (f a)) := by unfold fTransform mass @@ -715,7 +715,7 @@ lemma restrict_fTransform {A B : Type*} (f : A → B) (μ : Distribution A) (P : exact (mass_eq_zero_of_forall_not _ fun a (ha : f a = b ∧ P (f a)) => h (ha.1 ▸ ha.2)).symm /-- Pushforward preserves total mass. -/ -theorem weight_fTransform {A B : Type*} +lemma weight_fTransform {A B : Type*} (f : A → B) (X : Distribution A) : (fTransform f X).weight = X.weight := by unfold weight @@ -724,13 +724,13 @@ theorem weight_fTransform {A B : Type*} /-- Pushforward preserves non-negativity: the mass at each image point is a sum of non-negative source masses. -/ -theorem NonNeg.fTransform {A B : Type*} {X : Distribution A} (hX : X.NonNeg) +lemma NonNeg.fTransform {A B : Type*} {X : Distribution A} (hX : X.NonNeg) (f : A → B) : (Distribution.fTransform f X).NonNeg := fun b => by rw [fTransform_apply_eq_mass] exact hX.mass_nonneg _ /-- Pushforward preserves total probability mass. -/ -theorem fTransform_isProbDist {A B : Type*} (f : A → B) {X : Distribution A} +lemma fTransform_isProbDist {A B : Type*} (f : A → B) {X : Distribution A} (hX : X.isProbDist) : (fTransform f X).isProbDist := by refine ⟨hX.nonNeg.fTransform f, ?_⟩ rw [weight_fTransform] @@ -744,7 +744,7 @@ instance {A B : Type*} (f : A → B) (X : Distribution A) [IsProbability X] : /-- `isProbDist` normalizes through pushforward — for a non-negative source law. (Over the signed carrier the unconditional `↔` is false: a pushforward can merge cancelling signed masses into a non-negative law.) -/ -theorem isProbDist_fTransform {A B : Type*} (f : A → B) {X : Distribution A} +lemma isProbDist_fTransform {A B : Type*} (f : A → B) {X : Distribution A} (hX : X.NonNeg) : (fTransform f X).isProbDist ↔ X.isProbDist := by constructor @@ -756,7 +756,7 @@ theorem isProbDist_fTransform {A B : Type*} (f : A → B) {X : Distribution A} /-- An injective pushforward reflects non-negativity: every source mass shows up unmerged at its image point. -/ -theorem NonNeg.of_fTransform_injective {A B : Type*} {X : Distribution A} {f : A → B} +lemma NonNeg.of_fTransform_injective {A B : Type*} {X : Distribution A} {f : A → B} (hf : Function.Injective f) (h : (Distribution.fTransform f X).NonNeg) : X.NonNeg := fun a => by have := h (f a) @@ -765,7 +765,7 @@ theorem NonNeg.of_fTransform_injective {A B : Type*} {X : Distribution A} {f : A /-- `isProbDist` normalizes through an **injective** pushforward with no side condition: injectivity rules out merging cancelling signed masses. -/ @[simp] -theorem isProbDist_fTransform_of_injective {A B : Type*} {f : A → B} +lemma isProbDist_fTransform_of_injective {A B : Type*} {f : A → B} (hf : Function.Injective f) (X : Distribution A) : (fTransform f X).isProbDist ↔ X.isProbDist := by constructor @@ -775,7 +775,7 @@ theorem isProbDist_fTransform_of_injective {A B : Type*} {f : A → B} · exact fTransform_isProbDist f /-- Dividing every mass by `c` divides the total mass by `c`. -/ -theorem weight_mapRange_div {A : Type*} (X : Distribution A) (c : ℝ) : +lemma weight_mapRange_div {A : Type*} (X : Distribution A) (c : ℝ) : weight (Finsupp.mapRange (fun w => w / c) (by simp) X : Distribution A) = X.weight / c := by unfold weight @@ -844,7 +844,7 @@ noncomputable def condPMF {Ω A : Type*} (p : ProbDist Ω) · rw [weight_mapRange_div, weight_fTransform, weight_restrict] exact div_self hE⟩⟩ -theorem condPMF_apply {Ω A : Type*} (p : ProbDist Ω) +lemma condPMF_apply {Ω A : Type*} (p : ProbDist Ω) (X : RV (Ω := Ω) (A := A)) (E : Ω → Prop) (hE : p.val.mass E ≠ 0) (a : A) : (condPMF p X E).get hE a = @@ -880,7 +880,7 @@ The decidability of the fiber predicate is an explicit parameter rather than this file's classical local instance: the statement's `Finset.filter` then instantiates with the caller's ambient instance, whether classical or derived from `[DecidableEq B]`, so `rw` matches goals in both instance policies. -/ -theorem fTransform_apply_eq_sum +lemma fTransform_apply_eq_sum (f : A → B) (X : Distribution A) (b : B) [DecidablePred fun a : A => f a = b] : (fTransform f X) b = @@ -906,7 +906,7 @@ the fiber cardinality divided by the total cardinality. As in `fTransform_apply_eq_sum`, the fiber decidability is an explicit parameter so the statement's filter matches the caller's ambient instance. -/ -theorem fTransform_uniform_apply +lemma fTransform_uniform_apply (f : A → B) (b : B) [DecidablePred fun a : A => f a = b] : (fTransform f (uniform A)) b = @@ -918,7 +918,7 @@ theorem fTransform_uniform_apply /-- If every fiber of `f : A -> B` has the cardinality expected for a uniform map, pushing the uniform distribution on `A` forward along `f` gives the uniform distribution on `B`. -/ -theorem fTransform_uniform_eq_uniform_of_card_fiber_mul +lemma fTransform_uniform_eq_uniform_of_card_fiber_mul {A B : Type*} [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] [DecidableEq B] (f : A → B) @@ -952,7 +952,7 @@ theorem fTransform_uniform_eq_uniform_of_card_fiber_mul simp [c, d] /-- Summing against a pushforward distribution pulls the summand back. -/ -theorem fTransform_sum_mul +lemma fTransform_sum_mul (X : Distribution A) (f : A → B) (g : B → ℝ) : (∑ b : B, (fTransform f X) b * g b) = ∑ a : A, X a * g (f a) := by classical @@ -976,7 +976,7 @@ theorem fTransform_sum_mul /-- Evaluating a predicate after a pushforward is the same as evaluating the pulled-back predicate before the pushforward. -/ -theorem evalPred_fTransform +lemma evalPred_fTransform (X : Distribution A) (f : A → B) (P : B → Prop) : (fTransform f X).evalPred P = X.evalPred (fun a => P (f a)) := by classical @@ -1011,7 +1011,7 @@ def prod (X : Distribution A) (Y : Distribution B) : Distribution (A × B) := section omit [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] -theorem prod_apply (X : Distribution A) (Y : Distribution B) (a : A) (b : B) : +lemma prod_apply (X : Distribution A) (Y : Distribution B) (a : A) (b : B) : prod X Y (a, b) = X a * Y b := by classical -- Push evaluation inside the nested sums and discharge each sum via `Finsupp.sum_eq_single`. @@ -1043,7 +1043,7 @@ theorem prod_apply (X : Distribution A) (Y : Distribution B) (a : A) (b : B) : /-- An independent product is supported on the rectangle of the component supports: a pair carries mass only if both of its coordinates do. -/ -theorem support_prod_subset (X : Distribution A) (Y : Distribution B) : +lemma support_prod_subset (X : Distribution A) (Y : Distribution B) : (prod X Y).support ⊆ X.support ×ˢ Y.support := fun p hp => have hne : X p.1 * Y p.2 ≠ 0 := prod_apply X Y p.1 p.2 ▸ Finsupp.mem_support_iff.mp hp @@ -1054,7 +1054,7 @@ theorem support_prod_subset (X : Distribution A) (Y : Distribution B) : /-- The mass of an arbitrary event under an independent product as an iterated finite-support sum. The rectangle case is `mass_prod_and`; this unrestricted form is useful when the event couples the two coordinates. -/ -theorem mass_prod_eq_double_sum (X : Distribution A) (Y : Distribution B) (R : A × B → Prop) : +lemma mass_prod_eq_double_sum (X : Distribution A) (Y : Distribution B) (R : A × B → Prop) : (prod X Y).mass R = X.sum fun a wa => Y.sum fun b wb => if R (a, b) then wa * wb else 0 := by classical @@ -1069,7 +1069,7 @@ theorem mass_prod_eq_double_sum (X : Distribution A) (Y : Distribution B) (R : A rw [key (a, b)] /-- A weighted sum over an independent product is an iterated weighted sum. -/ -theorem sum_prod_mul (X : Distribution A) (Y : Distribution B) (f : A × B → ℝ) : +lemma sum_prod_mul (X : Distribution A) (Y : Distribution B) (f : A × B → ℝ) : (prod X Y).sum (fun p w => w * f p) = X.sum fun a wa => wa * Y.sum fun b wb => wb * f (a, b) := by classical @@ -1084,7 +1084,7 @@ theorem sum_prod_mul (X : Distribution A) (Y : Distribution B) (f : A × B → rw [key (a, b)] ring -theorem weight_prod (X : Distribution A) (Y : Distribution B) : +lemma weight_prod (X : Distribution A) (Y : Distribution B) : (prod X Y).weight = X.weight * Y.weight := by classical -- Support-based, so **no `Fintype` on the carriers**: sum the product mass over the finite @@ -1104,13 +1104,13 @@ theorem weight_prod (X : Distribution A) (Y : Distribution B) : _ = X.weight * Y.weight := by rw [← Finset.sum_mul_sum]; simp only [weight, Finsupp.sum] /-- Independent products preserve non-negativity. -/ -theorem NonNeg.prod {X : Distribution A} {Y : Distribution B} (hX : X.NonNeg) (hY : Y.NonNeg) : +lemma NonNeg.prod {X : Distribution A} {Y : Distribution B} (hX : X.NonNeg) (hY : Y.NonNeg) : (Distribution.prod X Y).NonNeg := fun p => by rw [show p = (p.1, p.2) from rfl, prod_apply] exact mul_nonneg (hX p.1) (hY p.2) /-- The product of two probability distributions is a probability distribution. -/ -theorem prod_isProbDist (X : Distribution A) (Y : Distribution B) +lemma prod_isProbDist (X : Distribution A) (Y : Distribution B) (hX : X.isProbDist) (hY : Y.isProbDist) : (prod X Y).isProbDist := by refine ⟨hX.nonNeg.prod hY.nonNeg, ?_⟩ rw [weight_prod, hX.weight_eq, hY.weight_eq, mul_one] @@ -1126,7 +1126,7 @@ the joint distribution of two **independently selected** random variables). -/ noncomputable def prodProbDist (P : ProbDist A) (Q : ProbDist B) : ProbDist (A × B) := ⟨prod P.val Q.val, prod_isProbDist P.val Q.val P.property Q.property⟩ -@[simp] theorem prodProbDist_val (P : ProbDist A) (Q : ProbDist B) : +@[simp] lemma prodProbDist_val (P : ProbDist A) (Q : ProbDist B) : (prodProbDist P Q).val = prod P.val Q.val := rfl /-- CR18 **Definition 4.9** (finite part). The **q-fold i.i.d. power** `X^q` of a distribution: @@ -1143,11 +1143,11 @@ noncomputable def iidPow (X : Distribution A) (q : ℕ) : Distribution (Fin q /-- The defining property of `X^q`: its mass is the product of the marginals (independence + identical marginal `X`). -/ -@[simp] theorem iidPow_apply (X : Distribution A) (q : ℕ) (f : Fin q → A) : +@[simp] lemma iidPow_apply (X : Distribution A) (q : ℕ) (f : Fin q → A) : iidPow X q f = ∏ i, X (f i) := by rw [iidPow]; exact Finsupp.onFinset_apply /-- The weight of `X^q` is the `q`-th power of the weight: `|X^q| = |X|^q`. -/ -theorem iidPow_weight (X : Distribution A) (q : ℕ) : (iidPow X q).weight = X.weight ^ q := by +lemma iidPow_weight (X : Distribution A) (q : ℕ) : (iidPow X q).weight = X.weight ^ q := by have hsub : (iidPow X q).support ⊆ Fintype.piFinset fun _ : Fin q => X.support := fun f hf => Fintype.mem_piFinset.mpr fun i => Finsupp.mem_support_iff.mpr fun hi => (iidPow_apply X q f ▸ Finsupp.mem_support_iff.mp hf) (Finset.prod_eq_zero (Finset.mem_univ i) hi) @@ -1164,7 +1164,7 @@ theorem iidPow_weight (X : Distribution A) (q : ℕ) : (iidPow X q).weight = X.w /-- `X^q` is a probability distribution whenever `X` is (CR18 Def 4.9: `X^q` is again a random variable) — the n-ary analogue of `prod_isProbDist`. -/ -theorem iidPow_isProbDist {X : Distribution A} (hX : X.isProbDist) (q : ℕ) : (iidPow X q).isProbDist := by +lemma iidPow_isProbDist {X : Distribution A} (hX : X.isProbDist) (q : ℕ) : (iidPow X q).isProbDist := by refine ⟨fun f => ?_, ?_⟩ · rw [iidPow_apply] exact Finset.prod_nonneg fun i _ => hX.nonNeg (f i) @@ -1181,20 +1181,20 @@ def clonePow (X : Distribution A) (q : ℕ) : Distribution (Fin q → A) := /-- `X^[q]` is supported on constant tuples: its mass at `g` is the `X`-mass of the values whose clone tuple is `g` (so `0` unless `g` is constant, and `X a` at the constant-`a` tuple). -/ -@[simp] theorem clonePow_apply (X : Distribution A) (q : ℕ) (g : Fin q → A) : +@[simp] lemma clonePow_apply (X : Distribution A) (q : ℕ) (g : Fin q → A) : clonePow X q g = X.mass (fun a => (fun _ => a) = g) := fTransform_apply_eq_mass _ X g end omit [Nonempty A] in /-- `mass` as a `Fintype` sum: `X.mass P = ∑ a, (if P a then X a else 0)`. -/ -theorem mass_eq_sum (X : Distribution A) (P : A → Prop) : +lemma mass_eq_sum (X : Distribution A) (P : A → Prop) : X.mass P = ∑ a, if P a then X a else 0 := by rw [Distribution.mass] exact Finsupp.sum_fintype _ _ (fun _ => by simp only [ite_self]) /-- Uniform event mass as a cardinality ratio. -/ -theorem uniform_mass_eq_card_filter (P : A → Prop) [DecidablePred P] : +lemma uniform_mass_eq_card_filter (P : A → Prop) [DecidablePred P] : (uniform A).mass P = (((Finset.univ : Finset A).filter P).card : ℝ) / (Fintype.card A : ℝ) := by @@ -1205,7 +1205,7 @@ theorem uniform_mass_eq_card_filter (P : A → Prop) [DecidablePred P] : /-- **Uniform-mass product law from a counting identity**: if `#P · |B| = #Q · #E` then `mass P = mass Q · mass E` over the uniform distributions. The algebraic endgame of balanced-fiber (re-randomisation) counting arguments: prove the count, read off the product law. -/ -theorem uniform_mass_eq_mass_mul_mass_of_card_mul_eq {A B : Type*} +lemma uniform_mass_eq_mass_mul_mass_of_card_mul_eq {A B : Type*} [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] (P E : A → Prop) (Q : B → Prop) [DecidablePred P] [DecidablePred E] [DecidablePred Q] (hcard : (Finset.univ.filter P).card * Fintype.card B @@ -1264,7 +1264,7 @@ theorem mass_prod_and (P : Distribution A) (Q : Distribution B) (R₁ : A → Pr omit [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] in /-- The mass of the singleton event `· = a` is just the weight `X a`. -/ -theorem mass_singleton (X : Distribution A) (a : A) : X.mass (fun b => b = a) = X a := by +lemma mass_singleton (X : Distribution A) (a : A) : X.mass (fun b => b = a) = X a := by classical unfold mass rw [Finsupp.sum_eq_single a (fun b _ hb => by simp [hb]) (by simp)] @@ -1273,7 +1273,7 @@ theorem mass_singleton (X : Distribution A) (a : A) : X.mass (fun b => b = a) = omit [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] in /-- **CR18 Def A.4 marginal** on the first coordinate of a product distribution: `P_X(x) = ∑_y P_{XY}(x,y)`, here `(prod P Q).mass (R ∘ fst) = P.mass R · weight Q`. -/ -theorem mass_prod_fst (P : Distribution A) (Q : Distribution B) (R : A → Prop) : +lemma mass_prod_fst (P : Distribution A) (Q : Distribution B) (R : A → Prop) : (prod P Q).mass (fun ab => R ab.1) = P.mass R * Q.weight := by rw [show (fun ab : A × B => R ab.1) = (fun ab => R ab.1 ∧ (fun _ : B => True) ab.2) from by funext; simp, @@ -1281,7 +1281,7 @@ theorem mass_prod_fst (P : Distribution A) (Q : Distribution B) (R : A → Prop) omit [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] in /-- **CR18 Def A.4 marginal** on the second coordinate of a product distribution. -/ -theorem mass_prod_snd (P : Distribution A) (Q : Distribution B) (R : B → Prop) : +lemma mass_prod_snd (P : Distribution A) (Q : Distribution B) (R : B → Prop) : (prod P Q).mass (fun ab => R ab.2) = P.weight * Q.mass R := by rw [show (fun ab : A × B => R ab.2) = (fun ab => (fun _ : A => True) ab.1 ∧ R ab.2) from by funext; simp, @@ -1294,7 +1294,7 @@ first factor, scaled by the total weight of the discarded factor. At distribution — the scaling is trivial (`one_smul`); the general form is what an optimal coupling needs, whose off-diagonal factors carry the transported mass rather than weight one. -/ -theorem fTransform_fst_prod (P : Distribution A) (Q : Distribution B) : +lemma fTransform_fst_prod (P : Distribution A) (Q : Distribution B) : fTransform Prod.fst (prod P Q) = Q.weight • P := by ext a rw [fTransform_apply_eq_mass, Finsupp.smul_apply, smul_eq_mul] @@ -1307,7 +1307,7 @@ theorem fTransform_fst_prod (P : Distribution A) (Q : Distribution B) : omit [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] in /-- Projecting an independent product onto its second coordinate recovers the second factor, scaled by the total weight of the discarded factor. -/ -theorem fTransform_snd_prod (P : Distribution A) (Q : Distribution B) : +lemma fTransform_snd_prod (P : Distribution A) (Q : Distribution B) : fTransform Prod.snd (prod P Q) = P.weight • Q := by ext b rw [fTransform_apply_eq_mass, Finsupp.smul_apply, smul_eq_mul] @@ -1317,7 +1317,7 @@ theorem fTransform_snd_prod (P : Distribution A) (Q : Distribution B) : simpa using mass_prod_snd P Q (fun y => y = b) _ = P.weight * Q b := by rw [mass_singleton] -theorem prod_uniform : +lemma prod_uniform : prod (uniform A) (uniform B) = uniform (A × B) := by classical ext p @@ -1331,7 +1331,7 @@ omit [Fintype A] [Nonempty A] in /-- The weight equals the Finsupp.sum with identity. (`rfl`; needs no `Fintype`/`Nonempty` — those are section-variable leaks, omitted so callers over arbitrary carriers, e.g. `Distribution gs.Game`, can use it without spurious `Nonempty` obligations.) -/ -theorem weight_eq_finsupp_sum (X : Distribution A) : +lemma weight_eq_finsupp_sum (X : Distribution A) : X.weight = X.sum (fun _ w => w) := by rfl @@ -1339,7 +1339,7 @@ omit [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] [Fintype C] [Nonempty C] /-- Composing two f-transformations equals the f-transformation of the composition. This is the pushforward functoriality law: `f_*(g_*(X)) = (f ∘ g)_*(X)`. -/ -theorem fTransform_comp +lemma fTransform_comp (g : B → C) (f : A → B) (X : Distribution A) : fTransform g (fTransform f X) = fTransform (g ∘ f) X := by show Finsupp.mapDomain g (Finsupp.mapDomain f X) = Finsupp.mapDomain (g ∘ f) X @@ -1354,7 +1354,7 @@ random variables on the same sample space. If stripping `aug` recovers All randomness, including fresh augmentation coins, belongs in the source law `X`; no product observation carrier or transcript-specific construction is involved. -/ -theorem fTransform_comp_eq_of_pointwise +lemma fTransform_comp_eq_of_pointwise (strip : B → C) (aug : A → B) (plain : A → C) (X : Distribution A) (h : ∀ a, strip (aug a) = plain a) : fTransform strip (fTransform aug X) = fTransform plain X := by @@ -1365,7 +1365,7 @@ omit [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] [Fintype C] [Nonempty C] /-- The pushforward is additive: it is `Finsupp.mapDomain`, a linear map, and mixtures therefore survive to the image. Stated for a `Finset` sum, which is the form a decomposition over a finite support takes. -/ -theorem fTransform_sum {A B ι : Type*} (f : A → B) (t : Finset ι) +lemma fTransform_sum {A B ι : Type*} (f : A → B) (t : Finset ι) (Z : ι → Distribution A) : fTransform f (∑ i ∈ t, Z i) = ∑ i ∈ t, fTransform f (Z i) := map_sum (Finsupp.mapDomain.addMonoidHom f) Z t @@ -1373,13 +1373,13 @@ theorem fTransform_sum {A B ι : Type*} (f : A → B) (t : Finset ι) omit [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] [Fintype C] [Nonempty C] in /-- The binary face of `fTransform_sum`: the pushforward of a sum of two distributions is the sum of the pushforwards. -/ -theorem fTransform_add {A B : Type*} (f : A → B) (Z W : Distribution A) : +lemma fTransform_add {A B : Type*} (f : A → B) (Z W : Distribution A) : fTransform f (Z + W) = fTransform f Z + fTransform f W := map_add (Finsupp.mapDomain.addMonoidHom f) Z W omit [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] [Fintype C] [Nonempty C] in /-- The pushforward commutes with scaling: mass is moved, not rescaled. -/ -theorem fTransform_smul {A B : Type*} (f : A → B) (c : ℝ) +lemma fTransform_smul {A B : Type*} (f : A → B) (c : ℝ) (Z : Distribution A) : fTransform f (c • Z) = c • fTransform f Z := Finsupp.mapDomain_smul c Z @@ -1387,7 +1387,7 @@ omit [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] [Fintype C] [Nonempty C] /-- Pushing a distribution forward by the identity map does not change it. -/ @[simp] -theorem fTransform_id {A : Type*} (X : Distribution A) : +lemma fTransform_id {A : Type*} (X : Distribution A) : fTransform id X = X := by ext a simpa using fTransform_injective_apply X id Function.injective_id a @@ -1400,7 +1400,7 @@ This is the distribution-level conservative-extension law used by extended transcript arguments: constant terminal side information carries no observable mass once projected away. -/ @[simp] -theorem fTransform_fst_const_pair {A U : Type*} (X : Distribution A) (u : U) : +lemma fTransform_fst_const_pair {A U : Type*} (X : Distribution A) (u : U) : fTransform (fun p : A × U => p.1) (fTransform (fun a : A => (a, u)) X) = X := by calc fTransform (fun p : A × U => p.1) (fTransform (fun a : A => (a, u)) X) @@ -1418,7 +1418,7 @@ variable [Fintype A'] [Nonempty A'] [Fintype B'] [Nonempty B'] Generalizes `fTransform_bijection_uniform` to maps between different types: if `e : A ≃ B` is an equivalence, then the pushforward of `uniform A` through `e` is `uniform B`. -/ -theorem fTransform_equiv_uniform (e : A' ≃ B') : +lemma fTransform_equiv_uniform (e : A' ≃ B') : fTransform e (uniform A') = uniform B' := by classical apply fTransform_uniform_eq_uniform_of_card_fiber_mul e @@ -1441,7 +1441,7 @@ end ProductUniform /-- **`prod` is a bifunctor for pushforward**: pushing an independent product forward coordinatewise is the independent product of the pushforwards. -/ -theorem fTransform_prod {A B A' B' : Type*} (f : A → A') (g : B → B') +lemma fTransform_prod {A B A' B' : Type*} (f : A → A') (g : B → B') (X : Distribution A) (Y : Distribution B) : fTransform (Prod.map f g) (prod X Y) = prod (fTransform f X) (fTransform g Y) := by ext p @@ -1451,20 +1451,20 @@ theorem fTransform_prod {A B A' B' : Type*} (f : A → A') (g : B → B') exact mass_congr _ fun q => by simp [Prod.map, Prod.ext_iff] /-- Pushing only the second factor forward is a pushforward of the product. -/ -theorem fTransform_prod_right {A B B' : Type*} (X : Distribution A) (g : B → B') +lemma fTransform_prod_right {A B B' : Type*} (X : Distribution A) (g : B → B') (Y : Distribution B) : prod X (fTransform g Y) = fTransform (Prod.map id g) (prod X Y) := by rw [fTransform_prod, fTransform_id] /-- Pushing only the first factor forward is a pushforward of the product. -/ -theorem fTransform_prod_left {A A' B : Type*} (f : A → A') (X : Distribution A) +lemma fTransform_prod_left {A A' B : Type*} (f : A → A') (X : Distribution A) (Y : Distribution B) : prod (fTransform f X) Y = fTransform (Prod.map f id) (prod X Y) := by rw [fTransform_prod, fTransform_id] /-- **Symmetry of the independent product**: exchanging the two coordinates exchanges the two factors. -/ -theorem fTransform_swap_prod {A B : Type*} (X : Distribution A) (Y : Distribution B) : +lemma fTransform_swap_prod {A B : Type*} (X : Distribution A) (Y : Distribution B) : fTransform Prod.swap (prod X Y) = prod Y X := by ext p obtain ⟨b, a⟩ := p @@ -1477,7 +1477,7 @@ theorem fTransform_swap_prod {A B : Type*} (X : Distribution A) (Y : Distributio /-- **Associativity of the independent product**: reassociating the sample reassociates the factors. -/ -theorem fTransform_assoc_prod {A B C : Type*} (X : Distribution A) (Y : Distribution B) +lemma fTransform_assoc_prod {A B C : Type*} (X : Distribution A) (Y : Distribution B) (Z : Distribution C) : fTransform (fun p : A × B × C => ((p.1, p.2.1), p.2.2)) (prod X (prod Y Z)) = prod (prod X Y) Z := by @@ -1494,7 +1494,7 @@ theorem fTransform_assoc_prod {A B C : Type*} (X : Distribution A) (Y : Distribu _ = prod (prod X Y) Z ((a, b), c) := by rw [prod_apply, prod_apply] /-- A fixed first coordinate is a pushforward of the second law. -/ -theorem prod_single_left {A B : Type*} (a : A) (Y : Distribution B) : +lemma prod_single_left {A B : Type*} (a : A) (Y : Distribution B) : prod (Finsupp.single a 1) Y = fTransform (fun b => (a, b)) Y := by classical rw [prod, Finsupp.sum_single_index (by @@ -1503,7 +1503,7 @@ theorem prod_single_left {A B : Type*} (a : A) (Y : Distribution B) : rfl /-- A fixed second coordinate is a pushforward of the first law. -/ -theorem prod_single_right {A B : Type*} (X : Distribution A) (b : B) : +lemma prod_single_right {A B : Type*} (X : Distribution A) (b : B) : prod X (Finsupp.single b 1) = fTransform (fun a => (a, b)) X := by rw [← fTransform_swap_prod, prod_single_left, fTransform_comp] rfl @@ -1513,7 +1513,7 @@ theorem prod_single_right {A B : Type*} (X : Distribution A) (b : B) : /-- **Fibering an event mass over the values of a statistic**: if `V` covers the image of `g` on the support, the mass of `P` splits into the masses of `P` on the fibers `g = v`. -/ -theorem mass_eq_sum_mass_fiber {A B : Type*} (μ : Distribution A) +lemma mass_eq_sum_mass_fiber {A B : Type*} (μ : Distribution A) (P : A → Prop) (g : A → B) (V : Finset B) (hV : ∀ a ∈ μ.support, g a ∈ V) : μ.mass P = ∑ v ∈ V, μ.mass fun a => P a ∧ g a = v := by @@ -1527,7 +1527,7 @@ theorem mass_eq_sum_mass_fiber {A B : Type*} (μ : Distribution A) · by_cases hP : P a <;> simp [hP] /-- The weight of a finite sum of laws is the sum of their weights. -/ -theorem weight_finset_sum {A ι : Type*} (t : Finset ι) +lemma weight_finset_sum {A ι : Type*} (t : Finset ι) (Rf : ι → Distribution A) : (∑ i ∈ t, Rf i).weight = ∑ i ∈ t, (Rf i).weight := by rw [weight_eq_finsupp_sum, @@ -1535,7 +1535,7 @@ theorem weight_finset_sum {A ι : Type*} (t : Finset ι) exact Finset.sum_congr rfl fun i _ => (weight_eq_finsupp_sum _).symm /-- A finite probabilistic choice of normalized laws is normalized. -/ -theorem isProbDist_sum_smul +lemma isProbDist_sum_smul {I A : Type*} (indices : Finset I) (weights : I → ℝ) (laws : I → Distribution A) (nonnegative : ∀ i ∈ indices, 0 ≤ weights i) (total : ∑ i ∈ indices, weights i = 1) @@ -1561,7 +1561,7 @@ theorem isProbDist_sum_smul /-- The pushforward of the zero law is the zero law. -/ @[simp] -theorem fTransform_zero {A B : Type*} (f : A → B) : +lemma fTransform_zero {A B : Type*} (f : A → B) : fTransform f (0 : Distribution A) = 0 := Finsupp.mapDomain_zero @@ -1572,30 +1572,30 @@ section Products variable {A : Type*} /-- Weight is homogeneous: `|c · X| = c · |X|`. Signed layer. -/ -theorem weight_smul (c : ℝ) (X : Distribution A) : (c • X).weight = c * X.weight := by +lemma weight_smul (c : ℝ) (X : Distribution A) : (c • X).weight = c * X.weight := by unfold weight rw [Finsupp.sum_smul_index fun _ => rfl] unfold Finsupp.sum rw [Finset.mul_sum] /-- Weight is additive. -/ -theorem weight_add (X Y : Distribution A) : +lemma weight_add (X Y : Distribution A) : (X + Y).weight = X.weight + Y.weight := Finsupp.sum_add_index' (fun _ => rfl) (fun _ _ _ => rfl) /-- The weight of a point mass is its mass. -/ @[simp] -theorem weight_single (a : A) (c : ℝ) : +lemma weight_single (a : A) (c : ℝ) : weight (Finsupp.single a c : Distribution A) = c := by unfold weight exact Finsupp.sum_single_index rfl -theorem mass_single (a : A) (c : ℝ) (P : A → Prop) : +lemma mass_single (a : A) (c : ℝ) (P : A → Prop) : mass (Finsupp.single a c : Distribution A) P = if P a then c else 0 := by unfold mass exact Finsupp.sum_single_index (ite_self 0) -theorem mass_prod_eq_sum {A' B' : Type} (P : Distribution A') (Q : Distribution B') +lemma mass_prod_eq_sum {A' B' : Type} (P : Distribution A') (Q : Distribution B') (C : A' → B' → Prop) : (Distribution.prod P Q).mass (fun p => C p.1 p.2) = P.sum fun a w => w * Q.mass (C a) := by rw [Distribution.mass_prod_eq_double_sum] @@ -1605,14 +1605,14 @@ theorem mass_prod_eq_sum {A' B' : Type} (P : Distribution A') (Q : Distribution refine Finsupp.sum_congr fun b _ => ?_ split_ifs <;> simp -theorem mass_prod_eq_sum_right {A' B' : Type} (P : Distribution A') (Q : Distribution B') +lemma mass_prod_eq_sum_right {A' B' : Type} (P : Distribution A') (Q : Distribution B') (C : A' → B' → Prop) : (Distribution.prod P Q).mass (fun p => C p.1 p.2) = Q.sum fun b w => w * P.mass (fun a => C a b) := by rw [← mass_prod_eq_sum Q P (fun b a => C a b), ← Distribution.fTransform_swap_prod, Distribution.mass_fTransform] rfl -theorem fTransform_prod_assoc {A B C D : Type} (f : (A × B) × C → D) (P : Distribution A) +lemma fTransform_prod_assoc {A B C D : Type} (f : (A × B) × C → D) (P : Distribution A) (Q : Distribution B) (R : Distribution C) : Distribution.fTransform f (Distribution.prod (Distribution.prod P Q) R) = Distribution.fTransform (fun p => f ((p.1, p.2.1), p.2.2)) (Distribution.prod P (Distribution.prod Q R)) := by @@ -1621,7 +1621,7 @@ theorem fTransform_prod_assoc {A B C D : Type} (f : (A × B) × C → D) (P : Di /-- Regrouping two independent pairs as the pairs of their first and of their second components. -/ -theorem independent_product_middle {A B C D : Type} +lemma independent_product_middle {A B C D : Type} (P : Distribution A) (Q : Distribution B) (R : Distribution C) (S : Distribution D) : Distribution.fTransform (fun p : (A × B) × (C × D) => ((p.1.1, p.2.1), (p.1.2, p.2.2))) (Distribution.prod (Distribution.prod P Q) (Distribution.prod R S)) = @@ -1652,19 +1652,19 @@ noncomputable def pi {ι : Type*} [Fintype ι] [DecidableEq ι] hf (Finset.prod_eq_zero (Finset.mem_univ i) h0)) @[simp] -theorem pi_apply {ι : Type*} [Fintype ι] [DecidableEq ι] (μ : ι → Distribution A) (f : ι → A) : +lemma pi_apply {ι : Type*} [Fintype ι] [DecidableEq ι] (μ : ι → Distribution A) (f : ι → A) : pi μ f = ∏ i, μ i (f i) := by rw [pi]; exact Finsupp.onFinset_apply /-- An independent product of non-negative factors is non-negative. -/ -theorem pi_nonNeg {ι : Type*} [Fintype ι] [DecidableEq ι] {μ : ι → Distribution A} +lemma pi_nonNeg {ι : Type*} [Fintype ι] [DecidableEq ι] {μ : ι → Distribution A} (h : ∀ i, (μ i).NonNeg) : (pi μ).NonNeg := fun f => by rw [pi_apply] exact Finset.prod_nonneg fun i _ => h i (f i) /-- The total mass of independent finite distributions is the product of their masses. -/ -theorem weight_pi {ι : Type*} [Fintype ι] [DecidableEq ι] (μ : ι → Distribution A) : +lemma weight_pi {ι : Type*} [Fintype ι] [DecidableEq ι] (μ : ι → Distribution A) : (pi μ).weight = ∏ i, (μ i).weight := by classical rw [weight_eq_finsupp_sum] @@ -1675,7 +1675,7 @@ theorem weight_pi {ι : Type*} [Fintype ι] [DecidableEq ι] (μ : ι → Distri exact (Finset.prod_univ_sum _ _).symm /-- Independent probability distributions form a probability distribution. -/ -theorem pi_isProbDist {ι : Type*} [Fintype ι] [DecidableEq ι] {μ : ι → Distribution A} +lemma pi_isProbDist {ι : Type*} [Fintype ι] [DecidableEq ι] {μ : ι → Distribution A} (h : ∀ i, (μ i).isProbDist) : (pi μ).isProbDist := ⟨pi_nonNeg fun i => (h i).1, by rw [weight_pi] @@ -1690,14 +1690,14 @@ instance {ι : Type*} [Fintype ι] [DecidableEq ι] (μ : ι → Distribution A) /-! ### Marginal bookkeeping -/ /-- Coordinate marginals are additive in the joint law. -/ -theorem marginalAt_add {ι : Type*} {T : ι → Type*} +lemma marginalAt_add {ι : Type*} {T : ι → Type*} (F G : Distribution ((i : ι) → T i)) (j : ι) : marginalAt (F + G) j = marginalAt F j + marginalAt G j := Finsupp.sum_add_index' (fun _ => Finsupp.single_zero _) (fun x b₁ b₂ => Finsupp.single_add (x j) b₁ b₂) /-- Coordinate marginals commute with scaling. -/ -theorem marginalAt_smul {ι : Type*} {T : ι → Type*} +lemma marginalAt_smul {ι : Type*} {T : ι → Type*} (c : ℝ) (F : Distribution ((i : ι) → T i)) (j : ι) : marginalAt (c • F) j = c • marginalAt F j := by unfold marginalAt @@ -1707,7 +1707,7 @@ theorem marginalAt_smul {ι : Type*} {T : ι → Type*} /-- The coordinate marginal of an independent product: the chosen factor, scaled by the total weights of all the other factors. -/ -theorem marginalAt_pi {ι : Type*} [Fintype ι] [DecidableEq ι] (μ : ι → Distribution A) (i : ι) : +lemma marginalAt_pi {ι : Type*} [Fintype ι] [DecidableEq ι] (μ : ι → Distribution A) (i : ι) : marginalAt (pi μ) i = (∏ j ∈ Finset.univ.erase i, (μ j).weight) • μ i := by classical @@ -1765,7 +1765,7 @@ theorem marginalAt_pi {ι : Type*} [Fintype ι] [DecidableEq ι] (μ : ι → Di /-- Under an independent product, an event not depending on coordinate `i` is independent of the value at `i`. -/ -theorem mass_pi_and_eq {ι : Type*} [Fintype ι] [DecidableEq ι] [Fintype A] [DecidableEq A] +lemma mass_pi_and_eq {ι : Type*} [Fintype ι] [DecidableEq ι] [Fintype A] [DecidableEq A] (μ : ι → Distribution A) (hμ : ∀ j, (μ j).weight = 1) (i : ι) (a : A) (ev : (ι → A) → Prop) (hev : ∀ f a', ev (Function.update f i a') ↔ ev f) : (pi μ).mass (fun f => ev f ∧ f i = a) = (pi μ).mass ev * μ i a := by @@ -1834,7 +1834,7 @@ theorem mass_pi_and_eq {ι : Type*} [Fintype ι] [DecidableEq ι] [Fintype A] [D /-- **Independent samples, truncated**: the first `k'` of `k` independent samples from a law of weight one are `k'` independent samples. -/ -theorem fTransform_pi_castLE [Fintype A] [DecidableEq A] (μ : Distribution A) (hμ : μ.weight = 1) +lemma fTransform_pi_castLE [Fintype A] [DecidableEq A] (μ : Distribution A) (hμ : μ.weight = 1) {k' k : ℕ} (h : k' ≤ k) : fTransform (fun t : Fin k → A => fun i : Fin k' => t (Fin.castLE h i)) (pi fun _ : Fin k => μ) = pi fun _ : Fin k' => μ := by diff --git a/src/Probability/Expectation.lean b/src/Probability/Expectation.lean index d77366c..7a5a8e5 100644 --- a/src/Probability/Expectation.lean +++ b/src/Probability/Expectation.lean @@ -47,13 +47,13 @@ def expect (X : Distribution A) (f : A → ℝ) : ℝ := /-- On a finite carrier, `expect` is the ordinary sum over all points — the `Finset.univ` unfolding used by proofs that reason over the whole carrier (cf. `weight_eq_sum`, `mass_eq_sum`). -/ -theorem expect_eq_sum [Fintype A] (X : Distribution A) (f : A → ℝ) : +lemma expect_eq_sum [Fintype A] (X : Distribution A) (f : A → ℝ) : X.expect f = ∑ a : A, X a * f a := Finsupp.sum_fintype X (fun a w => w * f a) fun a => zero_mul (f a) /-- `expect` may be computed over any `Finset` containing the support: the off-support summands vanish. -/ -theorem expect_eq_sum_of_support_subset (X : Distribution A) (f : A → ℝ) {s : Finset A} +lemma expect_eq_sum_of_support_subset (X : Distribution A) (f : A → ℝ) {s : Finset A} (hs : X.support ⊆ s) : X.expect f = ∑ a ∈ s, X a * f a := Finset.sum_subset hs fun a _ ha => by @@ -63,13 +63,13 @@ theorem expect_eq_sum_of_support_subset (X : Distribution A) (f : A → ℝ) {s /-- Additivity of expectation in the distribution. Signed layer: no hypothesis. -/ -theorem expect_add_left (X Y : Distribution A) (f : A → ℝ) : +lemma expect_add_left (X Y : Distribution A) (f : A → ℝ) : (X + Y).expect f = X.expect f + Y.expect f := Finsupp.sum_add_index' (fun a => zero_mul (f a)) fun a w₁ w₂ => add_mul w₁ w₂ (f a) /-- Scalar homogeneity of expectation in the distribution. Signed layer: no hypothesis. -/ -theorem expect_smul_left (r : ℝ) (X : Distribution A) (f : A → ℝ) : +lemma expect_smul_left (r : ℝ) (X : Distribution A) (f : A → ℝ) : (r • X).expect f = r * X.expect f := by unfold expect rw [Finsupp.sum_smul_index fun a => zero_mul (f a)] @@ -80,20 +80,20 @@ theorem expect_smul_left (r : ℝ) (X : Distribution A) (f : A → ℝ) : /-- Expectation under a difference of distributions is the difference of expectations. Signed layer: no hypothesis — this is the form consumed by `statDist`-style arguments on the signed carrier. -/ -theorem expect_sub_left (X Y : Distribution A) (f : A → ℝ) : +lemma expect_sub_left (X Y : Distribution A) (f : A → ℝ) : (X - Y).expect f = X.expect f - Y.expect f := Finsupp.sum_sub_index fun a w₁ w₂ => sub_mul w₁ w₂ (f a) /-- Expectation under the zero distribution vanishes. -/ @[simp] -theorem expect_zero_left (f : A → ℝ) : (0 : Distribution A).expect f = 0 := +lemma expect_zero_left (f : A → ℝ) : (0 : Distribution A).expect f = 0 := Finsupp.sum_zero_index /-! ### Linearity in the function — signed layer -/ /-- Additivity of expectation in the function. Signed layer: no hypothesis. -/ -theorem expect_add_right (X : Distribution A) (f g : A → ℝ) : +lemma expect_add_right (X : Distribution A) (f g : A → ℝ) : X.expect (f + g) = X.expect f + X.expect g := by unfold expect simp only [Pi.add_apply, mul_add] @@ -101,7 +101,7 @@ theorem expect_add_right (X : Distribution A) (f g : A → ℝ) : /-- Expectation pulls out a constant factor of the function. Signed layer: no hypothesis. (`expect_smul_right` is the `•` spelling.) -/ -theorem expect_const_mul (X : Distribution A) (r : ℝ) (f : A → ℝ) : +lemma expect_const_mul (X : Distribution A) (r : ℝ) (f : A → ℝ) : X.expect (fun a => r * f a) = r * X.expect f := by unfold expect Finsupp.sum rw [Finset.mul_sum] @@ -109,14 +109,14 @@ theorem expect_const_mul (X : Distribution A) (r : ℝ) (f : A → ℝ) : /-- Scalar homogeneity of expectation in the function. Signed layer: no hypothesis. -/ -theorem expect_smul_right (X : Distribution A) (r : ℝ) (f : A → ℝ) : +lemma expect_smul_right (X : Distribution A) (r : ℝ) (f : A → ℝ) : X.expect (r • f) = r * X.expect f := expect_const_mul X r f /-- Expectation of a difference of functions is the difference of expectations (the function-side mirror of `expect_sub_left`). Signed layer: no hypothesis. -/ -theorem expect_sub_right (X : Distribution A) (f g : A → ℝ) : +lemma expect_sub_right (X : Distribution A) (f g : A → ℝ) : X.expect (fun a => f a - g a) = X.expect f - X.expect g := by unfold expect Finsupp.sum rw [← Finset.sum_sub_distrib] @@ -124,13 +124,13 @@ theorem expect_sub_right (X : Distribution A) (f g : A → ℝ) : /-- Expectation of the zero function vanishes. -/ @[simp] -theorem expect_zero_right (X : Distribution A) : X.expect 0 = 0 := by +lemma expect_zero_right (X : Distribution A) : X.expect 0 = 0 := by unfold expect Finsupp.sum simp /-- Expectation of a constant is the constant times the total weight; at `weight = 1` this is `𝔼[c] = c`. Signed layer: no hypothesis. -/ -theorem expect_const (X : Distribution A) (c : ℝ) : +lemma expect_const (X : Distribution A) (c : ℝ) : X.expect (fun _ => c) = c * X.weight := by unfold expect weight Finsupp.sum rw [Finset.mul_sum] @@ -139,7 +139,7 @@ theorem expect_const (X : Distribution A) (c : ℝ) : /-- Expectation of a finite sum of functions is the sum of expectations (the finite-sum form of `expect_add_right`, mirroring mathlib's `MeasureTheory.integral_finset_sum`). Signed layer: no hypothesis. -/ -theorem expect_finset_sum {ι : Type*} (X : Distribution A) (s : Finset ι) +lemma expect_finset_sum {ι : Type*} (X : Distribution A) (s : Finset ι) (f : ι → A → ℝ) : X.expect (fun a => ∑ i ∈ s, f i a) = ∑ i ∈ s, X.expect (f i) := by unfold expect Finsupp.sum @@ -151,7 +151,7 @@ theorem expect_finset_sum {ι : Type*} (X : Distribution A) (s : Finset ι) /-- Expectation of a scaled indicator is the scalar times the event mass: `𝔼_X[c·𝟙[P]] = c·X(P)`. Signed layer: no hypothesis. Statement-level `[DecidablePred P]` per the decidability policy of `Probability.Distribution`. -/ -theorem expect_indicator_const (X : Distribution A) (P : A → Prop) [DecidablePred P] +lemma expect_indicator_const (X : Distribution A) (P : A → Prop) [DecidablePred P] (c : ℝ) : X.expect (fun a => if P a then c else 0) = c * X.mass P := by classical @@ -162,7 +162,7 @@ theorem expect_indicator_const (X : Distribution A) (P : A → Prop) [DecidableP /-- Expectation of an indicator is the event mass: `𝔼_X[𝟙[P]] = X(P)`. This is the relation of `expect` to `Distribution.mass`. Signed layer: no hypothesis. -/ -theorem expect_indicator (X : Distribution A) (P : A → Prop) [DecidablePred P] : +lemma expect_indicator (X : Distribution A) (P : A → Prop) [DecidablePred P] : X.expect (fun a => if P a then (1 : ℝ) else 0) = X.mass P := by rw [expect_indicator_const, one_mul] @@ -170,21 +170,21 @@ theorem expect_indicator (X : Distribution A) (P : A → Prop) [DecidablePred P] /-- Expectation of a nonnegative function under a nonnegative distribution is nonnegative. `NonNeg` layer. -/ -theorem expect_nonneg {X : Distribution A} (hX : X.NonNeg) {f : A → ℝ} +lemma expect_nonneg {X : Distribution A} (hX : X.NonNeg) {f : A → ℝ} (hf : ∀ a, 0 ≤ f a) : 0 ≤ X.expect f := Finset.sum_nonneg fun a _ => mul_nonneg (hX a) (hf a) /-- Monotonicity of expectation. `NonNeg` layer: fails signed (one point of mass `-1`). -/ -theorem expect_mono {X : Distribution A} (hX : X.NonNeg) {f g : A → ℝ} +lemma expect_mono {X : Distribution A} (hX : X.NonNeg) {f g : A → ℝ} (h : ∀ a, f a ≤ g a) : X.expect f ≤ X.expect g := Finset.sum_le_sum fun a _ => mul_le_mul_of_nonneg_left (h a) (hX a) /-- A uniform bound on `f` over the support bounds the expectation by `c · |X|`. `NonNeg` layer; the bound is only required where `X` has mass. -/ -theorem expect_le_mul_weight {X : Distribution A} (hX : X.NonNeg) {f : A → ℝ} {c : ℝ} +lemma expect_le_mul_weight {X : Distribution A} (hX : X.NonNeg) {f : A → ℝ} {c : ℝ} (h : ∀ a ∈ X.support, f a ≤ c) : X.expect f ≤ c * X.weight := by unfold expect weight Finsupp.sum @@ -238,19 +238,19 @@ def variance (X : Distribution A) (f : A → ℝ) : ℝ := /-- Nonnegativity of the `𝔼[(f-c)²]` form for any center `c`. `NonNeg` layer. -/ -theorem expect_sub_sq_nonneg {X : Distribution A} (hX : X.NonNeg) (f : A → ℝ) (c : ℝ) : +lemma expect_sub_sq_nonneg {X : Distribution A} (hX : X.NonNeg) (f : A → ℝ) (c : ℝ) : 0 ≤ X.expect fun a => (f a - c) ^ 2 := Finset.sum_nonneg fun a _ => mul_nonneg (hX a) (sq_nonneg _) /-- Variance is nonnegative. `NonNeg` layer (the `𝔼[(f-c)²]` form at `c = 𝔼f`; no normalization needed). -/ -theorem variance_nonneg {X : Distribution A} (hX : X.NonNeg) (f : A → ℝ) : +lemma variance_nonneg {X : Distribution A} (hX : X.NonNeg) (f : A → ℝ) : 0 ≤ X.variance f := expect_sub_sq_nonneg hX f _ /-- Expansion of the square about an arbitrary center: `𝔼[(f-c)²] = 𝔼[f²] - 2c·𝔼[f] + c²·|X|`. Signed layer: pure bilinearity. -/ -theorem expect_sub_sq (X : Distribution A) (f : A → ℝ) (c : ℝ) : +lemma expect_sub_sq (X : Distribution A) (f : A → ℝ) (c : ℝ) : (X.expect fun a => (f a - c) ^ 2) = (X.expect fun a => f a ^ 2) - 2 * c * X.expect f + c ^ 2 * X.weight := by unfold expect weight Finsupp.sum @@ -262,7 +262,7 @@ theorem expect_sub_sq (X : Distribution A) (f : A → ℝ) (c : ℝ) : `Var_X f = 𝔼[f²] - 𝔼[f]²` (mathlib: `ProbabilityTheory.variance_def'`). Weakest layer: `weight = 1` alone — nonnegativity of `X` plays no role in the *identity*, only in the sign of either side. -/ -theorem variance_eq_expect_sq_sub_sq_expect {X : Distribution A} (hw : X.weight = 1) +lemma variance_eq_expect_sq_sub_sq_expect {X : Distribution A} (hw : X.weight = 1) (f : A → ℝ) : X.variance f = (X.expect fun a => f a ^ 2) - X.expect f ^ 2 := by rw [variance, expect_sub_sq, hw] @@ -272,7 +272,7 @@ theorem variance_eq_expect_sq_sub_sq_expect {X : Distribution A} (hw : X.weight layer — this genuinely needs both conjuncts: `NonNeg` for the sign of the `𝔼[(f-c)²]` form and `weight = 1` to equate the two forms (the one-point law of mass `2` with `f = 1` gives `2 < 2²`). -/ -theorem expect_sq_sub_sq_expect_nonneg {X : Distribution A} (hX : X.isProbDist) +lemma expect_sq_sub_sq_expect_nonneg {X : Distribution A} (hX : X.isProbDist) (f : A → ℝ) : 0 ≤ (X.expect fun a => f a ^ 2) - X.expect f ^ 2 := by rw [← variance_eq_expect_sq_sub_sq_expect hX.2] @@ -304,7 +304,7 @@ theorem _root_.ConvexOn.map_expect_le {φ : ℝ → ℝ} /-- Expectation transports along a pushforward: `𝔼_{f_*X}[g] = 𝔼_X[g ∘ f]`. This identity holds for finite signed distributions. -/ -theorem expect_fTransform {B : Type*} (X : Distribution A) (f : A → B) (g : B → ℝ) : +lemma expect_fTransform {B : Type*} (X : Distribution A) (f : A → B) (g : B → ℝ) : (fTransform f X).expect g = X.expect (g ∘ f) := by classical unfold expect fTransform @@ -313,13 +313,13 @@ theorem expect_fTransform {B : Type*} (X : Distribution A) (f : A → B) (g : B exact Finsupp.sum_congr fun a _ => by simp /-- Integrands agreeing on the finite support have the same signed expectation. -/ -theorem expect_congr_of_support {X : Distribution A} {f g : A → ℝ} +lemma expect_congr_of_support {X : Distribution A} {f g : A → ℝ} (h : ∀ a ∈ X.support, f a = g a) : X.expect f = X.expect g := Finsupp.sum_congr fun a ha => by rw [h a ha] /-- Eta-expanded additivity of expectation in its integrand. -/ -theorem expect_add_right' (X : Distribution A) (f g : A → ℝ) : +lemma expect_add_right' (X : Distribution A) (f g : A → ℝ) : (X.expect fun a => f a + g a) = X.expect f + X.expect g := expect_add_right X f g diff --git a/src/Probability/Lift.lean b/src/Probability/Lift.lean index 6821073..6558ea9 100644 --- a/src/Probability/Lift.lean +++ b/src/Probability/Lift.lean @@ -31,14 +31,14 @@ namespace Probability /-- `a⁺ * a⁻ = 0`: at most one of the two parts of a real number is nonzero. This is the multiplicative face of `posPart_inf_negPart_eq_zero`. -/ -theorem posPart_mul_negPart (a : ℝ) : a⁺ * a⁻ = 0 := by +lemma posPart_mul_negPart (a : ℝ) : a⁺ * a⁻ = 0 := by rcases le_total a 0 with h | h · rw [posPart_eq_zero.mpr h, zero_mul] · rw [negPart_eq_zero.mpr h, mul_zero] /-- `a - a ⊓ b = (a - b)⁺` in a lattice-ordered additive group: the amount by which `a` exceeds `b` is exactly what the meet discards. -/ -theorem sub_inf_eq_posPart_sub {α : Type*} [Lattice α] [AddCommGroup α] +lemma sub_inf_eq_posPart_sub {α : Type*} [Lattice α] [AddCommGroup α] [AddLeftMono α] (a b : α) : a - a ⊓ b = (a - b)⁺ := by rw [posPart_def, sub_eq_add_neg, neg_inf, add_sup, add_neg_cancel, ← sub_eq_add_neg, sup_comm] @@ -46,7 +46,7 @@ theorem sub_inf_eq_posPart_sub {α : Type*} [Lattice α] [AddCommGroup α] /-- `a ⊓ b + (a - b)⁺ = a`: the meet plus the one-sided excess rebuilds `a`. This is the identity behind the diagonal of an optimal coupling, where the meet is the shared mass and the excess is what must be transported. -/ -theorem inf_add_posPart_sub {α : Type*} [Lattice α] [AddCommGroup α] +lemma inf_add_posPart_sub {α : Type*} [Lattice α] [AddCommGroup α] [AddLeftMono α] (a b : α) : a ⊓ b + (a - b)⁺ = a := by rw [← sub_inf_eq_posPart_sub, add_sub_cancel] @@ -58,35 +58,35 @@ variable {A : Type*} /-- `Distribution.NonNeg` is the `Finsupp` order relation `0 ≤ X`. Every mathlib fact about the ordered group `A →₀ ℝ` reaches a `NonNeg` hypothesis through this. -/ -theorem nonNeg_iff_zero_le {X : Distribution A} : X.NonNeg ↔ 0 ≤ X := by +lemma nonNeg_iff_zero_le {X : Distribution A} : X.NonNeg ↔ 0 ≤ X := by simp [NonNeg, Finsupp.le_def] /-! ## Positive and negative parts -/ /-- Pointwise formula for the positive part: `X⁺(a) = max(X(a), 0)`. -/ @[simp] -theorem posPart_apply (X : Distribution A) (a : A) : X⁺ a = max (X a) 0 := by +lemma posPart_apply (X : Distribution A) (a : A) : X⁺ a = max (X a) 0 := by simp [posPart_def, Finsupp.sup_apply] /-- Pointwise formula for the negative part: `X⁻(a) = max(-X(a), 0)`. -/ @[simp] -theorem negPart_apply (X : Distribution A) (a : A) : X⁻ a = max (-X a) 0 := by +lemma negPart_apply (X : Distribution A) (a : A) : X⁻ a = max (-X a) 0 := by simp [negPart_def, Finsupp.sup_apply] /-- The positive part is an honest (nonnegative) distribution: this is the lift itself — a signed `Distribution` produces a `NonNeg` one. -/ -theorem nonNeg_posPart (X : Distribution A) : (X⁺).NonNeg := fun a => by +lemma nonNeg_posPart (X : Distribution A) : (X⁺).NonNeg := fun a => by rw [posPart_apply]; exact le_max_right _ _ /-- The two parts never charge the same point: `X⁺(a)·X⁻(a) = 0`. -/ -theorem posPart_mul_negPart_apply (X : Distribution A) (a : A) : X⁺ a * X⁻ a = 0 := by +lemma posPart_mul_negPart_apply (X : Distribution A) (a : A) : X⁺ a * X⁻ a = 0 := by simpa using posPart_mul_negPart (X a) /-! ### The split and `statDist` -/ /-- **`statDist` is the weight of a positive part**: `δ(X, Y) = |(X - Y)⁺|`. No layer hypothesis and no `Fintype` assumption are required. -/ -theorem statDist_eq_weight_posPart (X Y : Distribution A) : +lemma statDist_eq_weight_posPart (X Y : Distribution A) : statDist X Y = ((X - Y)⁺).weight := by classical have hfun : ∀ a : A, ((X - Y)⁺) a = max (X a - Y a) 0 := fun a => by @@ -103,7 +103,7 @@ theorem statDist_eq_weight_posPart (X Y : Distribution A) : exact ha /-- A nonnegative distribution of zero total weight is the zero distribution. -/ -theorem eq_zero_of_nonNeg_of_weight_eq_zero {X : Distribution A} (hX : X.NonNeg) +lemma eq_zero_of_nonNeg_of_weight_eq_zero {X : Distribution A} (hX : X.NonNeg) (hw : X.weight = 0) : X = 0 := by refine Finsupp.ext fun a => ?_ rw [Finsupp.coe_zero, Pi.zero_apply] @@ -118,7 +118,7 @@ theorem eq_zero_of_nonNeg_of_weight_eq_zero {X : Distribution A} (hX : X.NonNeg) /-! ## Normalization -/ /-- Event mass is homogeneous: `(c · X)(P) = c · X(P)`. Signed layer. -/ -theorem mass_smul (c : ℝ) (X : Distribution A) (P : A → Prop) : +lemma mass_smul (c : ℝ) (X : Distribution A) (P : A → Prop) : (c • X).mass P = c * X.mass P := by classical unfold mass @@ -135,7 +135,7 @@ def normalize (X : Distribution A) : Distribution A := X.weight⁻¹ • X /-- Pointwise value of the normalization. -/ @[simp] -theorem normalize_apply (X : Distribution A) (a : A) : +lemma normalize_apply (X : Distribution A) (a : A) : X.normalize a = X.weight⁻¹ * X a := by simp [normalize] @@ -143,11 +143,11 @@ theorem normalize_apply (X : Distribution A) (a : A) : /-- Pointwise formula for the meet: `(X ⊓ Y)(a) = min(X(a), Y(a))`. -/ @[simp] -theorem inf_apply (X Y : Distribution A) (a : A) : (X ⊓ Y) a = min (X a) (Y a) := by +lemma inf_apply (X Y : Distribution A) (a : A) : (X ⊓ Y) a = min (X a) (Y a) := by rw [Finsupp.inf_apply] /-- A point mass with nonnegative weight is honest. -/ -theorem single_nonNeg {c : ℝ} (hc : 0 ≤ c) (a : A) : +lemma single_nonNeg {c : ℝ} (hc : 0 ≤ c) (a : A) : NonNeg (Finsupp.single a c : Distribution A) := by classical intro a' @@ -157,7 +157,7 @@ theorem single_nonNeg {c : ℝ} (hc : 0 ≤ c) (a : A) : · exact le_rfl /-- Weight is subtractive. -/ -theorem weight_sub (X Y : Distribution A) : +lemma weight_sub (X Y : Distribution A) : (X - Y).weight = X.weight - Y.weight := by have h := weight_add (X - Y) Y rw [sub_add_cancel] at h diff --git a/src/Probability/MultiCoupling.lean b/src/Probability/MultiCoupling.lean index 6c2adeb..441f373 100644 --- a/src/Probability/MultiCoupling.lean +++ b/src/Probability/MultiCoupling.lean @@ -52,17 +52,17 @@ def IsJointOf (joint : Distribution (Fin n → A)) (laws : Fin n → Distributio Prop := joint.NonNeg ∧ ∀ i, Distribution.marginalAt joint i = laws i -theorem IsJointOf.nonNeg {joint : Distribution (Fin n → A)} +lemma IsJointOf.nonNeg {joint : Distribution (Fin n → A)} {laws : Fin n → Distribution A} (h : IsJointOf joint laws) : joint.NonNeg := h.1 -theorem IsJointOf.marginalAt {joint : Distribution (Fin n → A)} +lemma IsJointOf.marginalAt {joint : Distribution (Fin n → A)} {laws : Fin n → Distribution A} (h : IsJointOf joint laws) (i : Fin n) : Distribution.marginalAt joint i = laws i := h.2 i /-- Marginals of a non-negative joint are non-negative, so the represented laws inherit the layer. -/ -theorem IsJointOf.nonNeg_law {joint : Distribution (Fin n → A)} +lemma IsJointOf.nonNeg_law {joint : Distribution (Fin n → A)} {laws : Fin n → Distribution A} (h : IsJointOf joint laws) (i : Fin n) : (laws i).NonNeg := by rw [← h.2 i] @@ -71,7 +71,7 @@ theorem IsJointOf.nonNeg_law {joint : Distribution (Fin n → A)} /-- A joint distribution has each marginal's total weight; in particular all marginals of one joint weigh the same, so Definition 2.27's standing same-weight hypothesis is forced rather than optional. -/ -theorem weight_eq_of_isJointOf {joint : Distribution (Fin n → A)} +lemma weight_eq_of_isJointOf {joint : Distribution (Fin n → A)} {laws : Fin n → Distribution A} (h : IsJointOf joint laws) (i : Fin n) : joint.weight = (laws i).weight := by rw [← h.2 i] @@ -89,7 +89,7 @@ noncomputable def supAgreement (laws : Fin n → Distribution A) : ℝ := /-- The inner supremum is non-negative — also when no joint exists, where the real `sSup` of the empty set is `0`. -/ -theorem supAgreement_nonneg (laws : Fin n → Distribution A) : +lemma supAgreement_nonneg (laws : Fin n → Distribution A) : 0 ≤ supAgreement laws := Real.sSup_nonneg fun b hb => by obtain ⟨joint, hjoint, rfl⟩ := hb @@ -98,7 +98,7 @@ theorem supAgreement_nonneg (laws : Fin n → Distribution A) : /-- The agreement masses of a representative tuple are bounded by the weight of any one representative, so Definition 2.27's inner supremum set is bounded above. -/ -theorem bddAbove_agreementSet (laws : Fin n → Distribution A) (i : Fin n) : +lemma bddAbove_agreementSet (laws : Fin n → Distribution A) (i : Fin n) : BddAbove {b : ℝ | ∃ joint, IsJointOf joint laws ∧ b = agreementMass joint} := by refine ⟨(laws i).weight, ?_⟩ @@ -110,7 +110,7 @@ theorem bddAbove_agreementSet (laws : Fin n → Distribution A) (i : Fin n) : The `NonNeg` side condition is what the empty-`sSup` convention costs: with no joint at all the supremum is `0`, which a signed law's weight need not bound. -/ -theorem supAgreement_le_weight (laws : Fin n → Distribution A) (i : Fin n) +lemma supAgreement_le_weight (laws : Fin n → Distribution A) (i : Fin n) (hnn : (laws i).NonNeg) : supAgreement laws ≤ (laws i).weight := by refine Real.sSup_le ?_ hnn.weight_nonneg @@ -123,7 +123,7 @@ and then Definition 2.27's inner set is **empty**: `IsJointOf` demands a non-negative joint, and the coordinate marginals of a non-negative joint are non-negative. The real `sSup` of the empty set is `0`, so a signed tuple contributes exactly `0`. -/ -theorem supAgreement_eq_zero_of_not_nonNeg {laws : Fin n → Distribution A} +lemma supAgreement_eq_zero_of_not_nonNeg {laws : Fin n → Distribution A} (hsigned : ¬ ∀ i, (laws i).NonNeg) : supAgreement laws = 0 := by obtain ⟨i, hi⟩ := not_forall.mp hsigned have hempty : {b : ℝ | ∃ joint, IsJointOf joint laws ∧ @@ -143,16 +143,16 @@ def selectPair {B : Type*} (i j : Fin n) (f : Fin n → B) : Fin 2 → B := fun k => if k = 0 then f i else f j @[simp] -theorem selectPair_zero {B : Type*} (i j : Fin n) (f : Fin n → B) : +lemma selectPair_zero {B : Type*} (i j : Fin n) (f : Fin n → B) : selectPair i j f 0 = f i := rfl @[simp] -theorem selectPair_one {B : Type*} (i j : Fin n) (f : Fin n → B) : +lemma selectPair_one {B : Type*} (i j : Fin n) (f : Fin n → B) : selectPair i j f 1 = f j := rfl /-- Projecting an `n`-tuple joint to two chosen coordinates yields a pair joint of the corresponding marginals. -/ -theorem isJointOf_selectPair {joint : Distribution (Fin n → A)} +lemma isJointOf_selectPair {joint : Distribution (Fin n → A)} {laws : Fin n → Distribution A} (h : IsJointOf joint laws) (i j : Fin n) (pair : Fin 2 → Distribution A) (h0 : pair 0 = laws i) (h1 : pair 1 = laws j) : @@ -170,7 +170,7 @@ theorem isJointOf_selectPair {joint : Distribution (Fin n → A)} /-- Total agreement implies agreement on any two chosen coordinates: the projected pair joint agrees at least as often as the tuple joint. -/ -theorem agreementMass_le_selectPair {joint : Distribution (Fin n → A)} +lemma agreementMass_le_selectPair {joint : Distribution (Fin n → A)} (hjoint : joint.NonNeg) (i j : Fin n) : agreementMass joint ≤ agreementMass (Distribution.fTransform (selectPair i j) joint) := by @@ -188,7 +188,7 @@ theorem agreementMass_le_selectPair {joint : Distribution (Fin n → A)} whenever a pair of laws occurs as two chosen marginals of a tuple, every tuple joint projects to a pair joint with at least the tuple's agreement, so the tuple's inner supremum is at most the pair's. -/ -theorem supAgreement_le_of_pair_marginals +lemma supAgreement_le_of_pair_marginals {laws : Fin n → Distribution A} (pairLaws : Fin 2 → Distribution A) (i j : Fin n) (h0 : pairLaws 0 = laws i) (h1 : pairLaws 1 = laws j) : supAgreement laws ≤ supAgreement pairLaws := by @@ -217,7 +217,7 @@ Theorem 2.29's `ℓ` at one representative tuple. -/ noncomputable def supportUnion (laws : Fin n → Distribution A) : Finset A := Finset.univ.biUnion fun i => (laws i).support -theorem support_subset_supportUnion (laws : Fin n → Distribution A) (i : Fin n) : +lemma support_subset_supportUnion (laws : Fin n → Distribution A) (i : Fin n) : (laws i).support ⊆ supportUnion laws := by classical intro a ha @@ -243,28 +243,28 @@ noncomputable def overlapDist [NeZero n] (laws : Fin n → Distribution A) : hmem (support_subset_supportUnion laws i h)).ge) @[simp] -theorem overlapDist_apply [NeZero n] (laws : Fin n → Distribution A) (a : A) : +lemma overlapDist_apply [NeZero n] (laws : Fin n → Distribution A) (a : A) : overlapDist laws a = Finset.univ.inf' Finset.univ_nonempty fun i => laws i a := rfl -theorem overlapDist_apply_le [NeZero n] (laws : Fin n → Distribution A) +lemma overlapDist_apply_le [NeZero n] (laws : Fin n → Distribution A) (i : Fin n) (a : A) : overlapDist laws a ≤ laws i a := Finset.inf'_le _ (Finset.mem_univ i) -theorem overlapDist_le [NeZero n] (laws : Fin n → Distribution A) (i : Fin n) : +lemma overlapDist_le [NeZero n] (laws : Fin n → Distribution A) (i : Fin n) : overlapDist laws ≤ laws i := Finsupp.le_def.mpr fun a => overlapDist_apply_le laws i a /-- A pointwise minimum of non-negative laws is non-negative (structural on a `NNReal` carrier, a side condition on the signed one). -/ -theorem overlapDist_nonNeg [NeZero n] {laws : Fin n → Distribution A} +lemma overlapDist_nonNeg [NeZero n] {laws : Fin n → Distribution A} (hnn : ∀ i, (laws i).NonNeg) : (overlapDist laws).NonNeg := fun a => by rw [overlapDist_apply] exact Finset.le_inf' _ _ fun i _ => hnn i a /-- The overlap weight as a sum over the support union. -/ -theorem weight_overlapDist_eq_sum [NeZero n] (laws : Fin n → Distribution A) : +lemma weight_overlapDist_eq_sum [NeZero n] (laws : Fin n → Distribution A) : (overlapDist laws).weight = ∑ a ∈ supportUnion laws, overlapDist laws a := by rw [Distribution.weight_eq_finsupp_sum, Finsupp.sum] @@ -275,7 +275,7 @@ theorem weight_overlapDist_eq_sum [NeZero n] (laws : Fin n → Distribution A) : half of the `n`-ary coupling lemma. Total agreement happens on constant tuples only, the constant value determines the tuple, and each constant tuple's mass is below every coordinate marginal. -/ -theorem agreementMass_le_weight_overlapDist [NeZero n] +lemma agreementMass_le_weight_overlapDist [NeZero n] {joint : Distribution (Fin n → A)} {laws : Fin n → Distribution A} (h : IsJointOf joint laws) : agreementMass joint ≤ (overlapDist laws).weight := by @@ -326,7 +326,7 @@ least — hence, with the bound above, exactly — the overlap weight Construction: embed the overlap diagonally and add an independent product of the residuals `lawsᵢ − overlap`, normalized by the common residual weight; each marginal reassembles to `overlap + residualᵢ = lawsᵢ`. -/ -theorem exists_isJointOf_weight_overlapDist_le_agreementMass [NeZero n] +lemma exists_isJointOf_weight_overlapDist_le_agreementMass [NeZero n] (laws : Fin n → Distribution A) (hnn : ∀ i, (laws i).NonNeg) {w : ℝ} (hweight : ∀ i, (laws i).weight = w) : ∃ joint : Distribution (Fin n → A), IsJointOf joint laws ∧ @@ -418,7 +418,7 @@ section PairCase variable {A : Type*} /-- The binary infimum over `Fin 2` is the `min` of the two values. -/ -theorem inf'_univ_fin_two {α : Type*} [LinearOrder α] (f : Fin 2 → α) : +lemma inf'_univ_fin_two {α : Type*} [LinearOrder α] (f : Fin 2 → α) : Finset.univ.inf' Finset.univ_nonempty f = min (f 0) (f 1) := by refine le_antisymm (le_min (Finset.inf'_le f (Finset.mem_univ 0)) @@ -436,7 +436,7 @@ sub-distribution generality — the classical overlap formula behind Definition Hypothesis-free on the signed carrier: `statDist` sums over the support of the *difference* and needs no side condition to see points where only the second law is charged. -/ -theorem weight_overlapDist_pair (P : Fin 2 → Distribution A) : +lemma weight_overlapDist_pair (P : Fin 2 → Distribution A) : (overlapDist P).weight = (P 0).weight - statDist (P 0) (P 1) := by classical have hδ : statDist (P 0) (P 1) diff --git a/src/Probability/StatisticalDistance.lean b/src/Probability/StatisticalDistance.lean index 881d2e8..ccbc1fd 100644 --- a/src/Probability/StatisticalDistance.lean +++ b/src/Probability/StatisticalDistance.lean @@ -39,7 +39,7 @@ namespace Probability /-- If an index type is empty, then the image of `Set.univ` under any function out of it is empty. -/ -theorem image_univ_eq_empty_of_not_nonempty {ι : Type*} {α : Type*} +lemma image_univ_eq_empty_of_not_nonempty {ι : Type*} {α : Type*} (f : ι → α) (hι : ¬ Nonempty ι) : f '' Set.univ = (∅ : Set α) := by ext x @@ -51,7 +51,7 @@ theorem image_univ_eq_empty_of_not_nonempty {ι : Type*} {α : Type*} /-- A pointwise upper bound on an `sSup` image over `Set.univ` also covers the empty-index case when the upper bound is nonnegative. -/ -theorem sSup_image_univ_le_of_forall {ι : Type*} (f : ι → ℝ) {a : ℝ} +lemma sSup_image_univ_le_of_forall {ι : Type*} (f : ι → ℝ) {a : ℝ} (ha : 0 ≤ a) (h : ∀ i, f i ≤ a) : sSup (f '' Set.univ) ≤ a := by by_cases hι : Nonempty ι @@ -89,7 +89,7 @@ noncomputable def statDist {A : Type*} (X Y : Distribution A) : ℝ := ∑ a ∈ (X - Y).support, max (X a - Y a) 0 /-- On a `Fintype` carrier, `statDist` is the sum over all points. -/ -theorem statDist_eq_sum_univ {A : Type*} [Fintype A] (X Y : Distribution A) : +lemma statDist_eq_sum_univ {A : Type*} [Fintype A] (X Y : Distribution A) : statDist X Y = ∑ a : A, max (X a - Y a) 0 := by classical rw [statDist] @@ -104,7 +104,7 @@ of the difference: the summand `max (X a - Y a) 0` vanishes wherever and the working form on carriers that are genuinely infinite — transcript spaces `List (X × Option Y)`, system laws `Distribution (DDS X Y)`. Taking `s = Finset.univ` recovers `statDist_eq_sum_univ`. -/ -theorem statDist_eq_sum_of_support_subset {A : Type*} (X Y : Distribution A) +lemma statDist_eq_sum_of_support_subset {A : Type*} (X Y : Distribution A) {s : Finset A} (hs : (X - Y).support ⊆ s) : statDist X Y = ∑ a ∈ s, max (X a - Y a) 0 := by rw [statDist] @@ -114,12 +114,12 @@ theorem statDist_eq_sum_of_support_subset {A : Type*} (X Y : Distribution A) rw [h, max_self] /-- Each summand of `statDist` is nonnegative, so the whole sum is. -/ -theorem statDist_nonneg {A : Type*} (X Y : Distribution A) : +lemma statDist_nonneg {A : Type*} (X Y : Distribution A) : 0 ≤ statDist X Y := Finset.sum_nonneg fun _ _ => le_max_right _ _ /-- `δ(X, X) = 0`. -/ -theorem statDist_self {A : Type*} (X : Distribution A) : +lemma statDist_self {A : Type*} (X : Distribution A) : statDist X X = 0 := by simp [statDist] @@ -130,7 +130,7 @@ Paper: For distributions of equal weight, No `Fintype`: the two sums run over `X.support ∪ Y.support`, which already covers both differences. -/ -theorem statDist_symm_of_eq_weight {A : Type*} +lemma statDist_symm_of_eq_weight {A : Type*} (X Y : Distribution A) (h : X.weight = Y.weight) : statDist X Y = statDist Y X := by have : DecidableEq A := Classical.decEq A @@ -174,7 +174,7 @@ Like the `Fintype` form it needs neither non-negativity nor equal weight: the pointwise lattice identity `max (x − y) 0 = x − min x y` is all it uses. The asymmetry the paper notes for unequal weight is visible — the right-hand side carries `|P|`, not `|Q|`. -/ -theorem statDist_eq_weight_sub_sum_min_of_support_subset {A : Type*} +lemma statDist_eq_weight_sub_sum_min_of_support_subset {A : Type*} (P Q : Distribution A) {s : Finset A} (hP : P.support ⊆ s) (hQ : Q.support ⊆ s) : statDist P Q = P.weight - ∑ a ∈ s, min (P a) (Q a) := by @@ -193,7 +193,7 @@ theorem statDist_eq_weight_sub_sum_min_of_support_subset {A : Type*} ← Distribution.weight_eq_sum_of_support_subset P hP] /-- The `Fintype` instance of the min form: take `s = Finset.univ`. -/ -theorem statDist_eq_weight_sub_sum_min {A : Type*} [Fintype A] (X Y : Distribution A) : +lemma statDist_eq_weight_sub_sum_min {A : Type*} [Fintype A] (X Y : Distribution A) : statDist X Y = X.weight - ∑ a : A, min (X a) (Y a) := statDist_eq_weight_sub_sum_min_of_support_subset X Y (fun a _ => Finset.mem_univ a) (fun a _ => Finset.mem_univ a) @@ -240,7 +240,7 @@ theorem statDist_eq_half_sum_abs_of_weight_eq {A : Type*} [Fintype A] No `Fintype`: all three sums run over the union of the three difference supports, and the estimate is the pointwise `max (a - c) 0 ≤ max (a - b) 0 + max (b - c) 0`. -/ -theorem statDist_triangle {A : Type*} +lemma statDist_triangle {A : Type*} (X Y Z : Distribution A) : statDist X Z ≤ statDist X Y + statDist Y Z := by have : DecidableEq A := Classical.decEq A @@ -267,7 +267,7 @@ theorem statDist_triangle {A : Type*} No `Fintype`: both sides are read on `X.support ∪ Y.support`, which already covers the difference's support. The generality is what lets the bound reach the carriers the random-systems layer uses, where no `Fintype` exists. -/ -theorem statDist_le_weight {A : Type*} +lemma statDist_le_weight {A : Type*} {X Y : Distribution A} (hX : X.NonNeg) (hY : Y.NonNeg) : statDist X Y ≤ X.weight := by have : DecidableEq A := Classical.decEq A @@ -280,7 +280,7 @@ theorem statDist_le_weight {A : Type*} /-- **Event-mass bound by statistical distance.** For any event, the one-sided gap between its masses is bounded by statistical distance. -/ -theorem mass_tsub_mass_le_statDist {A : Type*} +lemma mass_tsub_mass_le_statDist {A : Type*} (X Y : Distribution A) (P : A → Prop) : X.mass P - Y.mass P ≤ statDist X Y := by classical @@ -298,7 +298,7 @@ theorem mass_tsub_mass_le_statDist {A : Type*} /-- **Real-valued event-mass bound by statistical distance.** This is the real-valued form of `mass_tsub_mass_le_statDist`. -/ -theorem mass_sub_mass_le_statDist {A : Type*} +lemma mass_sub_mass_le_statDist {A : Type*} (X Y : Distribution A) (P : A → Prop) : ((X.mass P : ℝ) - (Y.mass P : ℝ)) ≤ (statDist X Y : ℝ) := mass_tsub_mass_le_statDist X Y P @@ -312,7 +312,7 @@ is the shared source `μ`, and the bound is the probability that the two readings of one sampled atom part company. Both sides are pushforwards of the *same* `μ` — that is what makes it an equality of couplings rather than a triangle inequality, and it is why no weight or `Fintype` hypothesis appears. -/ -theorem statDist_fTransform_le_mass_of_eq_off {A B : Type*} {μ : Distribution A} +lemma statDist_fTransform_le_mass_of_eq_off {A B : Type*} {μ : Distribution A} (hμ : μ.NonNeg) (F G : A → B) (P : A → Prop) (hoff : ∀ a ∈ μ.support, ¬ P a → F a = G a) : statDist (Distribution.fTransform F μ) (Distribution.fTransform G μ) @@ -392,7 +392,7 @@ theorem abs_expect_sub_expect_le_mul_statDist {A : Type*} the first distribution is heavier. This is the canonical binary hypothesis test induced by the two laws. Finite supports suffice even when the sample carrier itself is infinite. -/ -theorem statDist_eq_mass_sub_mass_pos {A : Type*} +lemma statDist_eq_mass_sub_mass_pos {A : Type*} (X Y : Distribution A) : (statDist X Y : ℝ) = (X.mass (fun a => Y a < X a) : ℝ) - @@ -437,7 +437,7 @@ noncomputable def avgSuccessProb {A : Type*} (X Y : Distribution A) (g : A → B /-- Structural form of `avgSuccessProb`: eliminating the complement event turns the success probability into the signed mass gap of the acceptance set of `g`, shifted by the total weight of `Y`. Unconditional. -/ -theorem avgSuccessProb_eq_mass_sub_mass_add_weight_div_two {A : Type*} +lemma avgSuccessProb_eq_mass_sub_mass_add_weight_div_two {A : Type*} (X Y : Distribution A) (g : A → Bool) : avgSuccessProb X Y g = (X.mass (fun a => g a = true) - Y.mass (fun a => g a = true) + @@ -509,7 +509,7 @@ theorem sSup_avgSuccessProb_eq_half_add_half_statDist {A : Type*} le_csSup hbdd ⟨_, Set.mem_univ _, rfl⟩ /-- A one-sided ratio lower bound controls the pointwise deficit. -/ -theorem sub_le_mul_of_one_sub_mul_le {a b eps : ℝ} +lemma sub_le_mul_of_one_sub_mul_le {a b eps : ℝ} (h_lower : (1 - eps) * b ≤ a) : b - a ≤ eps * b := by nlinarith [h_lower] @@ -525,7 +525,7 @@ noncomputable def probBad {A : Type*} /-- Adding deterministic terminal side information does not change the mass of a bad event that ignores that terminal component. -/ @[simp] -theorem probBad_const_pair {A U : Type*} +lemma probBad_const_pair {A U : Type*} (D : Distribution A) (B : A → Prop) (u : U) : probBad (Distribution.fTransform (fun a : A => (a, u)) D) (fun p : A × U => B p.1) = diff --git a/src/RandomSystems/Converter/ConverterAttachment.lean b/src/RandomSystems/Converter/ConverterAttachment.lean index 100e715..b7b4da5 100644 --- a/src/RandomSystems/Converter/ConverterAttachment.lean +++ b/src/RandomSystems/Converter/ConverterAttachment.lean @@ -34,7 +34,7 @@ variable {O J : Type} [Fintype O] [Fintype J] {U V : O → Type} {X Y : J → Ty omit [Fintype O] [∀ o, Fintype (U o)] [∀ o, Fintype (V o)] in /-- **The realizations of possible choices of a resource** are deterministic resources with its domain, replying at the queried interface. -/ -theorem RandomSystem.isResource_realization +lemma RandomSystem.isResource_realization (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) {R : RandomSystem (Σ j, X j) (Σ j, Y j) (Domain.ofInputs E m hE)} (hR : R.RepliesAtQueriedInterface) {g} (hg : R.2.isSubprobabilistic.PossibleChoice g) : @@ -54,7 +54,7 @@ theorem RandomSystem.isResource_realization omit [Fintype O] [∀ o, Fintype (U o)] [∀ o, Fintype (V o)] in /-- Every resource is the behavior of a PDS of deterministic resources with its domain. -/ -theorem RandomSystem.exists_resource_presentation +lemma RandomSystem.exists_resource_presentation (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) (R : RandomSystem (Σ j, X j) (Σ j, Y j) (Domain.ofInputs E m hE)) (hR : R.RepliesAtQueriedInterface) : @@ -69,7 +69,7 @@ theorem RandomSystem.exists_resource_presentation omit [Fintype O] [∀ o, Fintype (U o)] [∀ o, Fintype (V o)] in /-- The behavior of a PDS of deterministic resources replies at the queried interface. -/ -theorem RandomSystem.ofPDS_repliesAtQueriedInterface +lemma RandomSystem.ofPDS_repliesAtQueriedInterface (Q : Distribution.ProbDist {s : InterfaceSystem J X Y // IsDDS s ∧ SystemAlgebra.RepliesAtQueriedInterface s ∧ ∀ h, (s h).Dom ↔ E h}) : (RandomSystem.ofPDS Q.1 Q.2 (fun s _ _ _ _ => s.2.2.2 _) : @@ -97,7 +97,7 @@ noncomputable def attachPDS (hF' : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] omit [Fintype O] [Fintype J] [∀ o, Fintype (U o)] [∀ o, Fintype (V o)] [∀ j, Fintype (X j)] [∀ j, Fintype (Y j)] in -theorem behaviorMass_attachPDS (hF' : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] → F h → F p) {b : ℕ} +lemma behaviorMass_attachPDS (hF' : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] → F h → F p) {b : ℕ} (P : Distribution.ProbDist {a : InsideOutsideSystem O J U V X Y // IsDDCFrom E F b a}) (Q : Distribution.ProbDist {s : InterfaceSystem J X Y // IsDDS s ∧ RepliesAtQueriedInterface s ∧ ∀ h, (s h).Dom ↔ E h}) @@ -109,7 +109,7 @@ theorem behaviorMass_attachPDS (hF' : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [ omit [Fintype O] [Fintype J] [∀ o, Fintype (U o)] [∀ o, Fintype (V o)] [∀ j, Fintype (X j)] [∀ j, Fintype (Y j)] in -theorem resource_bound {b : ℕ} {a : InsideOutsideSystem O J U V X Y} (ha : IsDDC b a) +lemma resource_bound {b : ℕ} {a : InsideOutsideSystem O J U V X Y} (ha : IsDDC b a) (s : InterfaceSystem J X Y) (us xs ys) (tr : Transcript (pair a s) (connectionQueries resourceRoute resourceInput us) xs ys) (hd : ¬ (connectionQueries resourceRoute resourceInput us ys).Dom) : @@ -118,7 +118,7 @@ theorem resource_bound {b : ℕ} {a : InsideOutsideSystem O J U V X Y} (ha : IsD /-- On presentations, the attachment law is the behavior of the attached PDS, for any valid internal bound `c`. -/ -theorem resource_connectionLaw (hF' : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] → F h → F p) +lemma resource_connectionLaw (hF' : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] → F h → F p) {α : RandomSystem (Σ l, twoFam U Y l) (Σ l, twoFam V X l) (Domain.converter E m hE F n hF)} {R : RandomSystem (Σ j, X j) (Σ j, Y j) (Domain.ofInputs E m hE)} {b c : ℕ} (hc : IsPDCBehavior O J U V X Y E m hE F n hF c α) @@ -175,7 +175,7 @@ variable (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) (hF' : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] → F h → F p) /-- **The attachment of presentations presents the attachment.** -/ -theorem attach_presents (α : PDCBehavior O J U V X Y E m hE F n hF) +lemma attach_presents (α : PDCBehavior O J U V X Y E m hE F n hF) (R : RandomSystem (Σ j, X j) (Σ j, Y j) (Domain.ofInputs E m hE)) (hR : R.RepliesAtQueriedInterface) {b : ℕ} (P : Distribution.ProbDist {a : InsideOutsideSystem O J U V X Y // IsDDCFrom E F b a}) @@ -189,7 +189,7 @@ theorem attach_presents (α : PDCBehavior O J U V X Y E m hE F n hF) /-- **A completed internal transcript of probability one** gives its outside transcript probability one. -/ -theorem attach_mass_eq_one (α : PDCBehavior O J U V X Y E m hE F n hF) +lemma attach_mass_eq_one (α : PDCBehavior O J U V X Y E m hE F n hF) (R : RandomSystem (Σ j, X j) (Σ j, Y j) (Domain.ofInputs E m hE)) (hR : R.RepliesAtQueriedInterface) (h : List ((Σ o, U o) × (Σ o, V o))) (H : List (Two (Σ l, twoFam U Y l) (Σ j, X j) × Two (Σ l, twoFam V X l) (Σ j, Y j))) @@ -216,7 +216,7 @@ theorem attach_mass_eq_one (α : PDCBehavior O J U V X Y E m hE F n hF) exact lower /-- The attachment replies at the queried interface. -/ -theorem attach_repliesAtQueriedInterface (α : PDCBehavior O J U V X Y E m hE F n hF) +lemma attach_repliesAtQueriedInterface (α : PDCBehavior O J U V X Y E m hE F n hF) (R : RandomSystem (Σ j, X j) (Σ j, Y j) (Domain.ofInputs E m hE)) (hR : R.RepliesAtQueriedInterface) : (attach hE' hF' α R hR).RepliesAtQueriedInterface := by obtain ⟨b, P, hP⟩ := α.2 @@ -230,7 +230,7 @@ theorem attach_repliesAtQueriedInterface (α : PDCBehavior O J U V X Y E m hE F exact hne (s.2.2.1 _ x y (Part.eq_some_iff.mp (replies_snoc.mp hs).2)) /-- **Attaching the identity** leaves a resource unchanged. -/ -theorem attach_id (R : RandomSystem (Σ j, X j) (Σ j, Y j) (Domain.ofInputs E m hE)) +lemma attach_id (R : RandomSystem (Σ j, X j) (Σ j, Y j) (Domain.ofInputs E m hE)) (hR : R.RepliesAtQueriedInterface) : attach hE' hE' (PDCBehavior.id (m := m) (hE := hE) hE') R hR = R := by obtain ⟨Q, hQ⟩ := RandomSystem.exists_resource_presentation hE' R hR diff --git a/src/RandomSystems/Converter/ConverterDomain.lean b/src/RandomSystems/Converter/ConverterDomain.lean index da85343..91cb55c 100644 --- a/src/RandomSystems/Converter/ConverterDomain.lean +++ b/src/RandomSystems/Converter/ConverterDomain.lean @@ -50,11 +50,11 @@ def converterAdmits def Admitted {A B : Type} (D : List (A × B) → A → Prop) (h : List (A × B)) : Prop := ∀ p z t, h = p ++ z :: t → D p z.1 -@[simp] theorem admitted_nil {A B : Type} (D : List (A × B) → A → Prop) : Admitted D [] := by +@[simp] lemma admitted_nil {A B : Type} (D : List (A × B) → A → Prop) : Admitted D [] := by intro p z t he simp at he -theorem admitted_snoc {A B : Type} {D : List (A × B) → A → Prop} {h z} : +lemma admitted_snoc {A B : Type} {D : List (A × B) → A → Prop} {h z} : Admitted D (h ++ [z]) ↔ Admitted D h ∧ D h z.1 := by constructor · intro ha @@ -72,7 +72,7 @@ theorem admitted_snoc {A B : Type} {D : List (A × B) → A → Prop} {h z} : /-- **Restriction to a smaller domain**: a random system on `D`, set to zero on the histories not admitted by `D' ⊆ D`, is a random system on `D'`. -/ -theorem IsRandomSystem.restrict {A B : Type} {D D' : List (A × B) → A → Prop} +lemma IsRandomSystem.restrict {A B : Type} {D D' : List (A × B) → A → Prop} {p : List (A × B) → ℝ} (hp : IsRandomSystem D p) (hD : ∀ h x, D' h x → D h x) : IsRandomSystem D' (fun h => if Admitted D' h then p h else 0) := by refine ⟨by simp [hp.1], fun h => ?_, fun h x => ?_⟩ @@ -98,7 +98,7 @@ theorem IsRandomSystem.restrict {A B : Type} {D D' : List (A × B) → A → Pro rfl /-- A completed deterministic transcript fixes the preceding reply label. -/ -theorem Replies.replyLabel {α : InsideOutsideSystem O J U V X Y} (hα : SilentAtEmpty α) +lemma Replies.replyLabel {α : InsideOutsideSystem O J U V X Y} (hα : SilentAtEmpty α) {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} (hr : Replies α (h.map Prod.fst) (h.map Prod.snd)) : replyLabel α (h.map Prod.fst) = h.getLast?.map (fun z => z.2.1) := by @@ -110,7 +110,7 @@ theorem Replies.replyLabel {α : InsideOutsideSystem O J U V X Y} (hα : SilentA rw [replyLabel_of_mem α (by rw [hy]; exact Part.mem_some _)] simp -theorem Replies.admissible_iff_admitted {c : InsideOutsideSystem O J U V X Y} (hc : SilentAtEmpty c) +lemma Replies.admissible_iff_admitted {c : InsideOutsideSystem O J U V X Y} (hc : SilentAtEmpty c) {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} (hr : Replies c (h.map Prod.fst) (h.map Prod.snd)) : Admissible c (h.map Prod.fst) ↔ Admitted converterAdmits h := by @@ -125,7 +125,7 @@ theorem Replies.admissible_iff_admitted {c : InsideOutsideSystem O J U V X Y} (h simp only [Admits, hr.1.replyLabel hc, converterAdmits] exact ⟨fun ⟨ha, _, hz⟩ => ⟨ha, hz⟩, fun ⟨ha, hz⟩ => ⟨ha, hd, hz⟩⟩ -theorem replies_canon_iff (c : InsideOutsideSystem O J U V X Y) (hc : SilentAtEmpty c) +lemma replies_canon_iff (c : InsideOutsideSystem O J U V X Y) (hc : SilentAtEmpty c) (h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))) : Replies (canon c) (h.map Prod.fst) (h.map Prod.snd) ↔ Admitted converterAdmits h ∧ Replies c (h.map Prod.fst) (h.map Prod.snd) := by @@ -152,7 +152,7 @@ theorem replies_canon_iff (c : InsideOutsideSystem O J U V X Y) (hc : SilentAtEm tauto /-- Defined histories of a partial DDC are admissible. -/ -theorem IsDDC.admissible {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) +lemma IsDDC.admissible {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) {h : List (Σ l, twoFam U Y l)} (hd : (α h).Dom) : Admissible α h := by intro h' z e he subst he @@ -160,7 +160,7 @@ theorem IsDDC.admissible {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : exact ⟨fun hne => hα.dds.2 ⟨z :: e, rfl⟩ hne hd, hα.admits h' z hz⟩ /-- Completed histories of a partial DDC are admitted. -/ -theorem IsDDC.admitted_of_replies {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) +lemma IsDDC.admitted_of_replies {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} (hr : Replies α (h.map Prod.fst) (h.map Prod.snd)) : Admitted converterAdmits h := by by_cases hn : h.map Prod.fst = [] @@ -169,7 +169,7 @@ theorem IsDDC.admitted_of_replies {b : ℕ} {α : InsideOutsideSystem O J U V X · exact (hr.admissible_iff_admitted hα.dds.1).mp (hα.admissible (hr.dom hn)) /-- A partial converter is its own canonical restriction. -/ -theorem IsDDC.canon_eq {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) : canon α = α := by +lemma IsDDC.canon_eq {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) : canon α = α := by funext h by_cases hd : (α h).Dom · exact canon_of_admissible (hα.admissible hd) @@ -179,7 +179,7 @@ theorem IsDDC.canon_eq {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : I · exact (Part.eq_none_iff'.mpr hd).symm /-- Partial converters with the same completed histories on admitted inputs are equal. -/ -theorem IsDDC.eq_of_admitted_replies {bα bβ : ℕ} {α β : InsideOutsideSystem O J U V X Y} +lemma IsDDC.eq_of_admitted_replies {bα bβ : ℕ} {α β : InsideOutsideSystem O J U V X Y} (hα : IsDDC bα α) (hβ : IsDDC bβ β) (he : ∀ h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l)), Admitted converterAdmits h → (Replies α (h.map Prod.fst) (h.map Prod.snd) ↔ @@ -208,23 +208,23 @@ theorem IsDDC.eq_of_admitted_replies {bα bβ : ℕ} {α β : InsideOutsideSyste noncomputable def insideQueries (ys : List (Σ l, twoFam V X l)) : List (Σ j, X j) := restrict (some ()) (ys.map splitIn) -theorem insideQueries_append (ys zs : List (Σ l, twoFam V X l)) : +lemma insideQueries_append (ys zs : List (Σ l, twoFam V X l)) : insideQueries (ys ++ zs) = insideQueries ys ++ insideQueries zs := by simp only [insideQueries, List.map_append, restrict_append] -@[simp] theorem insideQueries_outside (o : O) (v : V o) : +@[simp] lemma insideQueries_outside (o : O) (v : V o) : insideQueries [(⟨⟨none, o⟩, v⟩ : Σ l, twoFam V X l)] = [] := by simp [insideQueries, splitIn] -@[simp] theorem insideQueries_inside (j : J) (x : X j) : +@[simp] lemma insideQueries_inside (j : J) (x : X j) : insideQueries [(⟨⟨some (), j⟩, x⟩ : Σ l, twoFam V X l)] = [⟨j, x⟩] := by simp [insideQueries, splitIn] -@[simp] theorem outsideInputs_outside (o : O) (u : U o) : +@[simp] lemma outsideInputs_outside (o : O) (u : U o) : outsideInputs [(⟨⟨none, o⟩, u⟩ : Σ l, twoFam U Y l)] = [⟨o, u⟩] := by simp [outsideInputs, splitIn] -@[simp] theorem outsideInputs_inside (j : J) (y : Y j) : +@[simp] lemma outsideInputs_inside (j : J) (y : Y j) : outsideInputs [(⟨⟨some (), j⟩, y⟩ : Σ l, twoFam U Y l)] = [] := by simp [outsideInputs, splitIn] @@ -238,7 +238,7 @@ def converterDomain (E : List (Σ j, X j) → Prop) (F : List (Σ o, U o) → Pr (insideQueries (h.map Prod.snd) = [] ∨ E (insideQueries (h.map Prod.snd))) /-- An input on the converter alphabets is an outside query or an inside reply. -/ -theorem length_eq_outsideInputs_add (xs : List (Σ l, twoFam U Y l)) : +lemma length_eq_outsideInputs_add (xs : List (Σ l, twoFam U Y l)) : xs.length = (outsideInputs xs).length + (restrict (some ()) (xs.map splitIn)).length := by induction xs with | nil => rfl @@ -247,7 +247,7 @@ theorem length_eq_outsideInputs_add (xs : List (Σ l, twoFam U Y l)) : simp [outsideInputs, splitIn, restrict_cons_self, restrict_cons_ne, ih] <;> omega /-- Each inside reply follows an inside query. -/ -theorem insideReplies_length_le {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} +lemma insideReplies_length_le {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} {x : Σ l, twoFam U Y l} (ha : Admitted converterAdmits h) (hx : converterAdmits h x) : (restrict (some ()) ((h.map Prod.fst ++ [x]).map splitIn)).length ≤ (insideQueries (h.map Prod.snd)).length := by @@ -271,7 +271,7 @@ theorem insideReplies_length_le {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam · simp [splitIn] at ih ⊢; omega /-- Admitted transcripts are bounded by the two domain bounds. -/ -theorem length_lt_of_converterDomain {E : List (Σ j, X j) → Prop} {F : List (Σ o, U o) → Prop} +lemma length_lt_of_converterDomain {E : List (Σ j, X j) → Prop} {F : List (Σ o, U o) → Prop} {m n : ℕ} (hE : ∀ h, E h → h.length ≤ m) (hF : ∀ h, F h → h.length ≤ n) {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} {x : Σ l, twoFam U Y l} (hx : converterDomain E F h x) : h.length < n + m := by @@ -309,7 +309,7 @@ structure IsDDCFrom (E : List (Σ j, X j) → Prop) (F : List (Σ o, U o) → Pr insideQueries (h.map Prod.snd) = [] ∨ E (insideQueries (h.map Prod.snd)) /-- Along a transcript of a DDC from `E` to `F`, the outside queries are in `F`. -/ -theorem IsDDCFrom.outsideInputs_mem {E : List (Σ j, X j) → Prop} {F : List (Σ o, U o) → Prop} +lemma IsDDCFrom.outsideInputs_mem {E : List (Σ j, X j) → Prop} {F : List (Σ o, U o) → Prop} {b : ℕ} {a : InsideOutsideSystem O J U V X Y} (ha : IsDDCFrom E F b a) {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} (hr : Replies a (h.map Prod.fst) (h.map Prod.snd)) : @@ -325,7 +325,7 @@ theorem IsDDCFrom.outsideInputs_mem {E : List (Σ j, X j) → Prop} {F : List ( section Identity /-- The first input of a legal history is an outside query. -/ -theorem outsideInputs_ne_nil {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} +lemma outsideInputs_ne_nil {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} {x : Σ l, twoFam U Y l} (ha : Admitted converterAdmits h) (hx : converterAdmits h x) : outsideInputs (h.map Prod.fst ++ [x]) ≠ [] := by rcases h with _ | ⟨⟨x₀, y₀⟩, t⟩ @@ -338,7 +338,7 @@ theorem outsideInputs_ne_nil {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V · simp [converterAdmits, admitAfter] at h₀ /-- Along a transcript of the identity, the inside queries are the outside queries. -/ -theorem insideQueries_eq_of_replies_id {h : List ((Σ l, twoFam X Y l) × (Σ l, twoFam Y X l))} +lemma insideQueries_eq_of_replies_id {h : List ((Σ l, twoFam X Y l) × (Σ l, twoFam Y X l))} (hr : Replies (idConverter J X Y) (h.map Prod.fst) (h.map Prod.snd)) : insideQueries (h.map Prod.snd) = outsideInputs (h.map Prod.fst) := by induction h using List.reverseRecOn with @@ -357,7 +357,7 @@ theorem insideQueries_eq_of_replies_id {h : List ((Σ l, twoFam X Y l) × (Σ l, obtain rfl := Part.mem_some_iff.mp hy' simp -theorem prefix_or_nil {A : Type} {E : List A → Prop} +lemma prefix_or_nil {A : Type} {E : List A → Prop} (hE : ∀ {p h}, p <+: h → p ≠ [] → E h → E p) : ∀ {p h : List A}, p <+: h → (h = [] ∨ E h) → (p = [] ∨ E p) := by intro p h hp hh @@ -367,7 +367,7 @@ theorem prefix_or_nil {A : Type} {E : List A → Prop} · exact Or.inl (List.prefix_nil.mp hp) · exact Or.inr (hE hp hn hh) -theorem DDC.isDDC_filter (D : List (Σ j, X j) → Prop) (hD : ∀ {p h}, p <+: h → D h → D p) : +lemma DDC.isDDC_filter (D : List (Σ j, X j) → Prop) (hD : ∀ {p h}, p <+: h → D h → D p) : IsDDC 1 (DDC.filter (Y := Y) D hD).1 := (idConverter_isResponsiveDDC (J := J) (X := X) (Y := Y)).isDDC.filterDom _ (fun {p h} hp _ hd => hD (by @@ -376,7 +376,7 @@ theorem DDC.isDDC_filter (D : List (Σ j, X j) → Prop) (hD : ∀ {p h}, p <+: /-- **A responsive DDC restricted to an outside domain `F`** is a DDC from `E` to `F` when the inside queries of its transcripts stay in `E`. -/ -theorem IsResponsiveDDC.isDDCFrom_filterDom {E : List (Σ j, X j) → Prop} +lemma IsResponsiveDDC.isDDCFrom_filterDom {E : List (Σ j, X j) → Prop} {F : List (Σ o, U o) → Prop} {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsResponsiveDDC b α) (hF : ∀ {p h}, p <+: h → p ≠ [] → F h → F p) (hq : ∀ h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l)), @@ -407,7 +407,7 @@ theorem IsResponsiveDDC.isDDCFrom_filterDom {E : List (Σ j, X j) → Prop} /-- **The identity from `E` to `E`** is the filter forwarding the outside queries in `E` (CR18, §3.4.3, printed p. 62). -/ -theorem isDDCFrom_filter {E : List (Σ j, X j) → Prop} +lemma isDDCFrom_filter {E : List (Σ j, X j) → Prop} (hE : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) : IsDDCFrom E E 1 (DDC.filter (Y := Y) (fun h => h = [] ∨ E h) (prefix_or_nil hE.2)).1 := (idConverter_isResponsiveDDC (J := J) (X := X) (Y := Y)).isDDCFrom_filterDom hE.2 @@ -419,7 +419,7 @@ theorem isDDCFrom_filter {E : List (Σ j, X j) → Prop} · exact ((filterDom_dom _ _ _).mp (hr.dom hn)).1 /-- A DDC from `E` to `F` is a DDC from any larger inside domain `E'` to `F`. -/ -theorem IsDDCFrom.inside_mono {E E' : List (Σ j, X j) → Prop} {F : List (Σ o, U o) → Prop} +lemma IsDDCFrom.inside_mono {E E' : List (Σ j, X j) → Prop} {F : List (Σ o, U o) → Prop} {b : ℕ} {a : InsideOutsideSystem O J U V X Y} (ha : IsDDCFrom E F b a) (hE : ∀ h, E h → E' h) : IsDDCFrom E' F b a where isDDC := ha.isDDC @@ -430,7 +430,7 @@ theorem IsDDCFrom.inside_mono {E E' : List (Σ j, X j) → Prop} {F : List (Σ o queries h hr := (ha.queries h hr).imp_right (hE _) /-- Attaching the identity from `E` to `E` leaves a resource with domain `E` unchanged. -/ -theorem trim_apply_filter_of_dom {E : List (Σ j, X j) → Prop} +lemma trim_apply_filter_of_dom {E : List (Σ j, X j) → Prop} (hE : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) {R : InterfaceSystem J X Y} (hR : IsDDS R) (hr : RepliesAtQueriedInterface R) (hRE : ∀ h, (R h).Dom ↔ E h) : trim (apply (DDC.filter (Y := Y) (fun h => h = [] ∨ E h) (prefix_or_nil hE.2)).1 R) = R := by @@ -479,7 +479,7 @@ def AttachCall (E : List (Σ j, X j) → Prop) (F : List (Σ o, U o) → Prop) /-- A call answers at its outside label and leaves the DDC idle: every admitted input is answered, and every query is in `E`, where the resource answers. -/ -theorem IsDDCFrom.attach_call (ha : IsDDCFrom E F b a) (hR : RepliesAtQueriedInterface R) +lemma IsDDCFrom.attach_call (ha : IsDDCFrom E F b a) (hR : RepliesAtQueriedInterface R) (hRE : ∀ h, (R h).Dom ↔ E h) {G o' G'} (l : Exchange (pair a R) resourceRoute G o' G') : ∀ o, AttachCall E F a o G → ∃ w : Σ o, V o, o' = some w ∧ w.1 = o ∧ AttachIdle a G' := by @@ -553,7 +553,7 @@ theorem IsDDCFrom.attach_call (ha : IsDDCFrom E F b a) (hR : RepliesAtQueriedInt /-- The next outside query after a completed history: answered exactly when it is in `F`, at its own label. -/ -theorem IsDDCFrom.attach_next (ha : IsDDCFrom E F b a) (hR : RepliesAtQueriedInterface R) +lemma IsDDCFrom.attach_next (ha : IsDDCFrom E F b a) (hR : RepliesAtQueriedInterface R) (hRE : ∀ h, (R h).Dom ↔ E h) {xs : List (Σ o, U o)} {o₀ H} (r : Induces (pair a R) resourceRoute resourceInput xs o₀ H) (hi : AttachIdle a H) (x : Σ o, U o) {o' H'} (lx : Exchange (pair a R) resourceRoute (H ++ [resourceInput x]) o' H') @@ -580,7 +580,7 @@ theorem IsDDCFrom.attach_next (ha : IsDDCFrom E F b a) (hR : RepliesAtQueriedInt exact ⟨w, hw, hw1, hi', hout ▸ hz.2.2.1⟩ /-- Every completed history of the attachment leaves the DDC idle. -/ -theorem IsDDCFrom.attach_idle (ha : IsDDCFrom E F b a) (hR : RepliesAtQueriedInterface R) +lemma IsDDCFrom.attach_idle (ha : IsDDCFrom E F b a) (hR : RepliesAtQueriedInterface R) (hRE : ∀ h, (R h).Dom ↔ E h) : ∀ xs ys, Replies (apply a R) xs ys → ∃ H, Induces (pair a R) resourceRoute resourceInput xs ys.getLast? H ∧ AttachIdle a H := by @@ -606,7 +606,7 @@ theorem IsDDCFrom.attach_idle (ha : IsDDCFrom E F b a) (hR : RepliesAtQueriedInt /-- **A DDC from `E` to `F` maps resources with domain `E` to resources with domain `F`**, replying at the queried interface. -/ -theorem IsDDCFrom.mapsDomain (ha : IsDDCFrom E F b a) +lemma IsDDCFrom.mapsDomain (ha : IsDDCFrom E F b a) (hF : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] → F h → F p) : MapsDomain E F a := by intro R _ hR hRE have next : ∀ xs ys x, Replies (apply a R) xs ys → @@ -696,26 +696,26 @@ def SerialCall (E : List (Σ j, X j) → Prop) (F : List (Σ m, Xm m) → Prop) outsideInputs (ha.map Prod.fst ++ [z]) = insideQueries (hb.map Prod.snd) ∧ insideQueries (ha.map Prod.snd) = Q) -theorem getLast?_label {A K : Type} {F : K → Type} +lemma getLast?_label {A K : Type} {F : K → Type} {h : List (A × (Σ l, F l))} {y : Σ l, F l} (hy : h.getLast?.map Prod.snd = some y) : h.getLast?.map (fun z => z.2.1) = some y.1 := by rw [show (fun z : A × (Σ l, F l) => z.2.1) = (fun y => y.1) ∘ Prod.snd from rfl, ← Option.map_map, hy] rfl -theorem getLast?_snd {A B : Type} {h : List (A × B)} {p : A × B} (hp : p ∈ h.getLast?) : +lemma getLast?_snd {A B : Type} {h : List (A × B)} {p : A × B} (hp : p ∈ h.getLast?) : p.2 ∈ (h.map Prod.snd).getLast? := by rw [List.getLast?_map, Option.mem_def.mp hp] rfl -theorem converterAdmits_of_idle {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} +lemma converterAdmits_of_idle {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} (hl : ∀ z ∈ h.getLast?, ¬ IsInside z.2) (x : Σ l, twoFam U Y l) : converterAdmits h x ↔ x.1.1 = none := admitAfter_of_ne fun j hj => by obtain ⟨p, hp, hpj⟩ := Option.map_eq_some_iff.mp hj exact hl p hp (by simp [IsInside, hpj]) -theorem converterAdmits_of_query {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} +lemma converterAdmits_of_query {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} {j : J} {x : X j} (hl : h.getLast?.map Prod.snd = some ⟨⟨some (), j⟩, x⟩) (z : Σ l, twoFam U Y l) : converterAdmits h z ↔ z.1 = ⟨some (), j⟩ := by rw [converterAdmits, getLast?_label hl] @@ -723,7 +723,7 @@ theorem converterAdmits_of_query {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFa /-- A call of the composite ends with an exposed output: every input reaching a component lies in its domain. -/ -theorem IsDDCFrom.serial_call (hβ : IsDDCFrom F G bβ β) (hα : IsDDCFrom E F bα α) +lemma IsDDCFrom.serial_call (hβ : IsDDCFrom F G bβ β) (hα : IsDDCFrom E F bα α) {P : List (Σ o, U o)} {Q : List (Σ j, X j)} (hP : G P) {K o' K'} (l : Exchange (pair β α) serialRouteM K o' K') : SerialCall E F G β α P Q K → @@ -822,7 +822,7 @@ theorem IsDDCFrom.serial_call (hβ : IsDDCFrom F G bβ β) (hα : IsDDCFrom E F /-- The composite's next input: in its domain exactly when the composite answers it, and then the components are again behind a composite step. -/ -theorem IsDDCFrom.serial_next (hβ : IsDDCFrom F G bβ β) (hα : IsDDCFrom E F bα α) +lemma IsDDCFrom.serial_next (hβ : IsDDCFrom F G bβ β) (hα : IsDDCFrom E F bα α) {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} {K} (hr : Replies (serialM β α) (h.map Prod.fst) (h.map Prod.snd)) (hs : SerialAfter G β α (outsideInputs (h.map Prod.fst)) (insideQueries (h.map Prod.snd)) @@ -944,7 +944,7 @@ theorem IsDDCFrom.serial_next (hβ : IsDDCFrom F G bβ β) (hα : IsDDCFrom E F hQ⟩) /-- Every completed history of the composite has its components behind it. -/ -theorem IsDDCFrom.serial_idle (hβ : IsDDCFrom F G bβ β) (hα : IsDDCFrom E F bα α) : +lemma IsDDCFrom.serial_idle (hβ : IsDDCFrom F G bβ β) (hα : IsDDCFrom E F bα α) : ∀ h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l)), Replies (serialM β α) (h.map Prod.fst) (h.map Prod.snd) → ∃ K, Induces (pair β α) serialRouteM serialInjM (h.map Prod.fst) @@ -972,7 +972,7 @@ theorem IsDDCFrom.serial_idle (hβ : IsDDCFrom F G bβ β) (hα : IsDDCFrom E F /-- **Serial composition of DDCs from `E` to `F` and from `F` to `G` is a DDC from `E` to `G`**, with the product of the inside-query bounds. -/ -theorem IsDDCFrom.comp (hβ : IsDDCFrom F G bβ β) (hα : IsDDCFrom E F bα α) : +lemma IsDDCFrom.comp (hβ : IsDDCFrom F G bβ β) (hα : IsDDCFrom E F bα α) : IsDDCFrom E G (bα * bβ) (trim (serialM β α)) := by refine ⟨hβ.isDDC.comp hα.isDDC, fun h x hr => ?_, fun h hr => ?_⟩ · rw [replies_trim_iff] at hr @@ -997,7 +997,7 @@ theorem IsDDCFrom.comp (hβ : IsDDCFrom F G bβ β) (hα : IsDDCFrom E F bα α) /-- **Two DDCs from `E` to `F` whose transcripts are transcripts of one system have the same transcripts.** -/ -theorem IsDDCFrom.replies_iff_of_le {γ s W : InsideOutsideSystem O M U V Xm Ym} {c b : ℕ} +lemma IsDDCFrom.replies_iff_of_le {γ s W : InsideOutsideSystem O M U V Xm Ym} {c b : ℕ} (hγ : IsDDCFrom F G c γ) (hs : IsDDCFrom F G b s) (hγW : ∀ xs ys, Replies γ xs ys → Replies W xs ys) (hsW : ∀ xs ys, Replies s xs ys → Replies W xs ys) @@ -1026,7 +1026,7 @@ theorem IsDDCFrom.replies_iff_of_le {γ s W : InsideOutsideSystem O M U V Xm Ym} exact ⟨key hs hγ hsW hγW h, key hγ hs hγW hsW h⟩ /-- Composing with the identity on the inside changes no transcript. -/ -theorem IsDDCFrom.replies_serialM_filter (hβ : IsDDCFrom F G bβ β) +lemma IsDDCFrom.replies_serialM_filter (hβ : IsDDCFrom F G bβ β) (hF : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] → F h → F p) (h : List ((Σ l, twoFam U Ym l) × (Σ l, twoFam V Xm l))) : Replies (trim (serialM β (DDC.filter (Y := Ym) (fun h => h = [] ∨ F h) @@ -1044,7 +1044,7 @@ theorem IsDDCFrom.replies_serialM_filter (hβ : IsDDCFrom F G bβ β) exact hm /-- Composing with the identity on the outside changes no transcript. -/ -theorem IsDDCFrom.replies_filter_serialM (hβ : IsDDCFrom F G bβ β) +lemma IsDDCFrom.replies_filter_serialM (hβ : IsDDCFrom F G bβ β) (hG : ¬ G [] ∧ ∀ {p h}, p <+: h → p ≠ [] → G h → G p) (h : List ((Σ l, twoFam U Ym l) × (Σ l, twoFam V Xm l))) : Replies (trim (serialM (DDC.filter (Y := V) (fun h => h = [] ∨ G h) diff --git a/src/RandomSystems/Converter/ConverterRelabel.lean b/src/RandomSystems/Converter/ConverterRelabel.lean index 1d3d4a2..ee541f6 100644 --- a/src/RandomSystems/Converter/ConverterRelabel.lean +++ b/src/RandomSystems/Converter/ConverterRelabel.lean @@ -21,7 +21,7 @@ namespace SystemAlgebra open Classical -theorem renameConverter_mem {O J : Type} {U V : O → Type} {X Y : J → Type} +lemma renameConverter_mem {O J : Type} {U V : O → Type} {X Y : J → Type} (f : (Σ o, U o) → (Σ j, X j)) (g : (Σ j, Y j) → (Σ o, V o)) : ∀ h y, y ∈ renameConverter f g h → y ∈ relabel (forwardAll J X Y) (outsideMap f) (outsideMap g) h := @@ -36,13 +36,13 @@ variable {O O' J : Type} {U V : O → Type} {U' V' : O' → Type} {X Y : J → T include hf hg in /-- The renaming converter is the canonical restriction of relabeled forwarding. -/ -theorem renameConverter_eq_canon : +lemma renameConverter_eq_canon : renameConverter f g = canon (relabel (forwardAll O U V) (outsideMap f) (outsideMap g)) := (canon_outsideMap e f g hf hg (forwardAll O U V)).symm include hf hg in /-- A renamed partial converter is a partial converter. -/ -theorem IsDDC.relabelOutside {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) : +lemma IsDDC.relabelOutside {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) : IsDDC b (relabel α (outsideMap f) (outsideMap g)) := by refine ⟨⟨?_, ?_⟩, fun h z hd => ?_, fun h hd => ?_, fun h y o hy hl => ?_⟩ · simpa only [SilentAtEmpty, relabel, List.map_nil, Part.map_Dom] using hα.dds.1 @@ -68,7 +68,7 @@ theorem IsDDC.relabelOutside {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (h include hf hg in /-- Composing a partial converter after a renaming converter relabels it. -/ -theorem IsDDC.trim_renameConverter_serialM {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) : +lemma IsDDC.trim_renameConverter_serialM {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) : trim (serialM (renameConverter f g) α) = relabel α (outsideMap f) (outsideMap g) := by have hr := (renameConverter_isResponsiveDDC e f g hf hg).isDDC apply (hr.comp hα).eq_of_admitted_replies (hα.relabelOutside e f g hf hg) @@ -90,7 +90,7 @@ variable {O J J' : Type} {U V : O → Type} {X Y : J → Type} {X' Y' : J' → T include hk hl in /-- Composing a partial converter before a renaming converter relabels its inside, on admitted histories. -/ -theorem IsDDC.replies_serialM_renameConverter {b : ℕ} {α : InsideOutsideSystem O J U V X Y} +lemma IsDDC.replies_serialM_renameConverter {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) (h : List ((Σ l, twoFam U Y' l) × (Σ l, twoFam V X' l))) (hh : Admitted converterAdmits h) : Replies (serialM α (renameConverter k l)) (h.map Prod.fst) (h.map Prod.snd) ↔ @@ -108,7 +108,7 @@ section Relabeling variable {O J O' J' : Type} {U V : O → Type} {X Y : J → Type} {U' V' : O' → Type} {X' Y' : J' → Type} -theorem admitAfter_twoMap (e : O' → O) (κ : J' → J) (hκ : Function.Injective κ) +lemma admitAfter_twoMap (e : O' → O) (κ : J' → J) (hκ : Function.Injective κ) (r : Option (Two O' J')) (l : Two O' J') : admitAfter (r.map (twoMap e κ)) (twoMap e κ l) ↔ admitAfter r l := by rcases r with _ | ⟨_ | ⟨⟨⟩⟩, r⟩ <;> rcases l with ⟨_ | ⟨⟨⟩⟩, l⟩ <;> @@ -116,7 +116,7 @@ theorem admitAfter_twoMap (e : O' → O) (κ : J' → J) (hκ : Function.Injecti /-- A relabeling preserving outside/inside labels, with one injective map on inside labels, preserves the admission of the next input. -/ -theorem converterAdmits_map_iff +lemma converterAdmits_map_iff (i : (Σ l, twoFam U' Y' l) → (Σ l, twoFam U Y l)) (o : (Σ l, twoFam V' X' l) → (Σ l, twoFam V X l)) (e : O' → O) (κ : J' → J) (hκ : Function.Injective κ) @@ -133,7 +133,7 @@ theorem converterAdmits_map_iff /-- A relabeling preserving outside/inside labels, with one injective map on inside labels, preserves admitted histories. -/ -theorem admitted_map_iff +lemma admitted_map_iff (i : (Σ l, twoFam U' Y' l) → (Σ l, twoFam U Y l)) (o : (Σ l, twoFam V' X' l) → (Σ l, twoFam V X l)) (e : O' → O) (κ : J' → J) (hκ : Function.Injective κ) @@ -148,7 +148,7 @@ theorem admitted_map_iff exact and_congr Iff.rfl (converterAdmits_map_iff i o e κ hκ hi ho h z.1) /-- Relabeling transports agreement of completed histories on admitted inputs. -/ -theorem replies_relabel_congr_of_admitted +lemma replies_relabel_congr_of_admitted {s t : InsideOutsideSystem O J U V X Y} (i : (Σ l, twoFam U' Y' l) ≃ (Σ l, twoFam U Y l)) (o : (Σ l, twoFam V X l) ≃ (Σ l, twoFam V' X' l)) @@ -213,7 +213,7 @@ section Transport variable {O O' J : Type} {U V : O → Type} {U' V' : O' → Type} {X Y : J → Type} -theorem outsideInputs_outsideMap (f : (Σ o, U' o) → (Σ o, U o)) (xs : List (Σ l, twoFam U' Y l)) : +lemma outsideInputs_outsideMap (f : (Σ o, U' o) → (Σ o, U o)) (xs : List (Σ l, twoFam U' Y l)) : outsideInputs (xs.map (outsideMap f)) = (outsideInputs xs).map f := by induction xs using List.reverseRecOn with | nil => rfl @@ -223,7 +223,7 @@ theorem outsideInputs_outsideMap (f : (Σ o, U' o) → (Σ o, U o)) (xs : List ( rcases x with ⟨⟨_ | ⟨⟨⟩⟩, o⟩, u⟩ <;> simp [outsideInputs, outsideMap, splitIn, restrict_cons_self, restrict_cons_ne] -theorem insideQueries_outsideMap (g : (Σ o, V o) → (Σ o, V' o)) (ys : List (Σ l, twoFam V X l)) : +lemma insideQueries_outsideMap (g : (Σ o, V o) → (Σ o, V' o)) (ys : List (Σ l, twoFam V X l)) : insideQueries (ys.map (outsideMap g)) = insideQueries ys := by induction ys using List.reverseRecOn with | nil => rfl @@ -237,7 +237,7 @@ variable {E : List (Σ j, X j) → Prop} {F : List (Σ o, U o) → Prop} {F' : L /-- **Relabeling the outside of a DDC from `E` to `F`** by a label-preserving bijection gives a DDC from `E` to the transported outside domain. -/ -theorem IsDDCFrom.relabelOutside (e : O' ≃ O) (f : (Σ o, U' o) ≃ (Σ o, U o)) +lemma IsDDCFrom.relabelOutside (e : O' ≃ O) (f : (Σ o, U' o) ≃ (Σ o, U o)) (g : (Σ o, V o) ≃ (Σ o, V' o)) (hf : ∀ u, (f u).1 = e u.1) (hg : ∀ v, (g v).1 = e.symm v.1) (hd : ∀ h, F (h.map f) ↔ F' h) {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDCFrom E F b α) : IsDDCFrom E F' b (relabel α (outsideMap f) (outsideMap g)) := by diff --git a/src/RandomSystems/Converter/ConverterTensor.lean b/src/RandomSystems/Converter/ConverterTensor.lean index df173bf..3ddce9d 100644 --- a/src/RandomSystems/Converter/ConverterTensor.lean +++ b/src/RandomSystems/Converter/ConverterTensor.lean @@ -78,7 +78,7 @@ def tensorInputs : (Σ l, twoFam U Y l) ≃ abbrev tensorOutputs := (tensorInputs (U := V) (Y := X)).symm /-- Completed parallel histories are exactly pairs of completed component histories. -/ -theorem replies_tensorRaw_iff +lemma replies_tensorRaw_iff (a : InsideOutsideSystem O J (U ∘ Sum.inl) (V ∘ Sum.inl) (X ∘ Sum.inl) (Y ∘ Sum.inl)) (b : InsideOutsideSystem O' J' (U ∘ Sum.inr) (V ∘ Sum.inr) (X ∘ Sum.inr) (Y ∘ Sum.inr)) (h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))) : @@ -98,7 +98,7 @@ theorem replies_tensorRaw_iff /-! ## Projections of joint histories -/ -theorem outsideInputs_left (xs : List (Σ l, twoFam U Y l)) : +lemma outsideInputs_left (xs : List (Σ l, twoFam U Y l)) : restrict none ((outsideInputs xs).map (sumAlphabet U).symm) = outsideInputs (restrict none (xs.map tIn)) := by induction xs using List.reverseRecOn with @@ -109,7 +109,7 @@ theorem outsideInputs_left (xs : List (Σ l, twoFam U Y l)) : rcases x with ⟨⟨_ | ⟨⟨⟩⟩, (o | o)⟩, u⟩ <;> simp [outsideInputs, splitIn, sumAlphabet, tIn, restrict_cons_self, restrict_cons_ne] -theorem outsideInputs_right (xs : List (Σ l, twoFam U Y l)) : +lemma outsideInputs_right (xs : List (Σ l, twoFam U Y l)) : restrict (some ()) ((outsideInputs xs).map (sumAlphabet U).symm) = outsideInputs (restrict (some ()) (xs.map tIn)) := by induction xs using List.reverseRecOn with @@ -120,7 +120,7 @@ theorem outsideInputs_right (xs : List (Σ l, twoFam U Y l)) : rcases x with ⟨⟨_ | ⟨⟨⟩⟩, (o | o)⟩, u⟩ <;> simp [outsideInputs, splitIn, sumAlphabet, tIn, restrict_cons_self, restrict_cons_ne] -theorem insideQueries_left (ys : List (Σ l, twoFam V X l)) : +lemma insideQueries_left (ys : List (Σ l, twoFam V X l)) : restrict none ((insideQueries ys).map (sumAlphabet X).symm) = insideQueries (restrict none (ys.map tensorOutputs.symm)) := by induction ys using List.reverseRecOn with @@ -132,7 +132,7 @@ theorem insideQueries_left (ys : List (Σ l, twoFam V X l)) : simp [insideQueries, splitIn, sumAlphabet, tensorInputs, tIn, restrict_cons_self, restrict_cons_ne] -theorem insideQueries_right (ys : List (Σ l, twoFam V X l)) : +lemma insideQueries_right (ys : List (Σ l, twoFam V X l)) : restrict (some ()) ((insideQueries ys).map (sumAlphabet X).symm) = insideQueries (restrict (some ()) (ys.map tensorOutputs.symm)) := by induction ys using List.reverseRecOn with @@ -155,7 +155,7 @@ variable {O O' J J' : Type} {U V : O ⊕ O' → Type} {X Y : J ⊕ J' → Type} {β : InsideOutsideSystem O' J' (U ∘ Sum.inr) (V ∘ Sum.inr) (X ∘ Sum.inr) (Y ∘ Sum.inr)} {bα bβ : ℕ} -theorem parallelLeft_snd {A B C E : Type} {h : List ((Two A C) × (Two B E))} +lemma parallelLeft_snd {A B C E : Type} {h : List ((Two A C) × (Two B E))} (hh : RandomSystem.parallelConsistent h) : (RandomSystem.parallelLeft h).map Prod.snd = restrict none (h.map Prod.snd) := by induction h with @@ -166,7 +166,7 @@ theorem parallelLeft_snd {A B C E : Type} {h : List ((Two A C) × (Two B E))} rcases z with ⟨⟨_ | ⟨⟩, x⟩, ⟨_ | ⟨⟩, y⟩⟩ <;> simp_all [RandomSystem.parallelLeft] -theorem parallelRight_snd {A B C E : Type} {h : List ((Two A C) × (Two B E))} +lemma parallelRight_snd {A B C E : Type} {h : List ((Two A C) × (Two B E))} (hh : RandomSystem.parallelConsistent h) : (RandomSystem.parallelRight h).map Prod.snd = restrict (some ()) (h.map Prod.snd) := by induction h with @@ -178,7 +178,7 @@ theorem parallelRight_snd {A B C E : Type} {h : List ((Two A C) × (Two B E))} simp_all [RandomSystem.parallelRight] /-- The component answering the next input is admitting it. -/ -theorem tensor_admits_left (hα : IsDDC bα α) (hβ : IsDDC bβ β) +lemma tensor_admits_left (hα : IsDDC bα α) (hβ : IsDDC bβ β) {h : List (Σ l : Two (O ⊕ O') (J ⊕ J'), twoFam U Y l)} {z : Σ l : Two (O ⊕ O') (J ⊕ J'), twoFam U Y l} {a} (inv : TInv α β h) (hadm : Admits (tensorRaw α β) h z) (hz : tIn z = ⟨none, a⟩) : @@ -200,7 +200,7 @@ theorem tensor_admits_left (hα : IsDDC bα α) (hβ : IsDDC bβ β) · rw [hl] at hl'; simp at hl' · cases hz -theorem tensor_admits_right (hα : IsDDC bα α) (hβ : IsDDC bβ β) +lemma tensor_admits_right (hα : IsDDC bα α) (hβ : IsDDC bβ β) {h : List (Σ l : Two (O ⊕ O') (J ⊕ J'), twoFam U Y l)} {z : Σ l : Two (O ⊕ O') (J ⊕ J'), twoFam U Y l} {a} (inv : TInv α β h) (hadm : Admits (tensorRaw α β) h z) (hz : tIn z = ⟨some (), a⟩) : @@ -222,14 +222,14 @@ theorem tensor_admits_right (hα : IsDDC bα α) (hβ : IsDDC bβ β) show admitAfter (replyLabel β (hB h)) ⟨some (), o⟩ rw [hj]; rfl -theorem tensorRaw_silentAtEmpty (α : InsideOutsideSystem O J (U ∘ Sum.inl) (V ∘ Sum.inl) (X ∘ Sum.inl) (Y ∘ Sum.inl)) +lemma tensorRaw_silentAtEmpty (α : InsideOutsideSystem O J (U ∘ Sum.inl) (V ∘ Sum.inl) (X ∘ Sum.inl) (Y ∘ Sum.inl)) (β : InsideOutsideSystem O' J' (U ∘ Sum.inr) (V ∘ Sum.inr) (X ∘ Sum.inr) (Y ∘ Sum.inr)) : SilentAtEmpty (tensorRaw α β) := by simp [SilentAtEmpty, tensorRaw, relabel, pair, parAll] /-- A canonical converter answers the next input of an admitted transcript exactly when the input is admitted and the converter answers it. -/ -theorem canon_snoc_dom_iff {O J : Type} {U V : O → Type} {X Y : J → Type} +lemma canon_snoc_dom_iff {O J : Type} {U V : O → Type} {X Y : J → Type} {c : InsideOutsideSystem O J U V X Y} (hc : SilentAtEmpty c) {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} (ha : Admitted converterAdmits h) (hr : Replies c (h.map Prod.fst) (h.map Prod.snd)) (x : Σ l, twoFam U Y l) : @@ -246,7 +246,7 @@ theorem canon_snoc_dom_iff {O J : Type} {U V : O → Type} {X Y : J → Type} exact ⟨fun h => absurd h Part.not_none_dom, fun h => absurd (hx.mpr h.1) hd⟩ /-- The components of a joint transcript of `α ⊗ β`. -/ -theorem replies_tensorL_split +lemma replies_tensorL_split {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} (hr : Replies (SystemAlgebra.tensorL α β) (h.map Prod.fst) (h.map Prod.snd)) : Admitted converterAdmits h ∧ @@ -283,7 +283,7 @@ theorem replies_tensorL_split /-- **The parallel composition of DDCs from `E₁` to `F₁` and from `E₂` to `F₂` is a DDC from `E₁ ∥ E₂` to `F₁ ∥ F₂`**, with the larger of the two inside-query bounds. -/ -theorem IsDDCFrom.tensorL {E₁ : List (Σ j, (X ∘ Sum.inl) j) → Prop} +lemma IsDDCFrom.tensorL {E₁ : List (Σ j, (X ∘ Sum.inl) j) → Prop} {E₂ : List (Σ j, (X ∘ Sum.inr) j) → Prop} {F₁ : List (Σ o, (U ∘ Sum.inl) o) → Prop} {F₂ : List (Σ o, (U ∘ Sum.inr) o) → Prop} (hα : IsDDCFrom E₁ F₁ bα α) (hβ : IsDDCFrom E₂ F₂ bβ β) : @@ -374,7 +374,7 @@ theorem IsDDCFrom.tensorL {E₁ : List (Σ j, (X ∘ Sum.inl) j) → Prop} rw [hrF] at hF₂ exact hF₂.resolve_left (outsideInputs_ne_nil hadmβ hax) -theorem parallelInputs_length_le {I J : Type} {F : I ⊕ J → Type} +lemma parallelInputs_length_le {I J : Type} {F : I ⊕ J → Type} {E₁ : List (Σ i, F (.inl i)) → Prop} {E₂ : List (Σ j, F (.inr j)) → Prop} {m₁ m₂ : ℕ} (hE₁ : ∀ h, E₁ h → h.length ≤ m₁) (hE₂ : ∀ h, E₂ h → h.length ≤ m₂) (h : List (Σ l, F l)) (hh : parallelInputs E₁ E₂ h) : h.length ≤ m₁ + m₂ := by @@ -392,7 +392,7 @@ theorem parallelInputs_length_le {I J : Type} {F : I ⊕ J → Type} /-- Two domains that contain every nonempty history of at most `k` queries contain it in parallel. -/ -theorem parallelInputs_of_length_le {I J : Type} {F : I ⊕ J → Type} +lemma parallelInputs_of_length_le {I J : Type} {F : I ⊕ J → Type} {E₁ : List (Σ i, F (.inl i)) → Prop} {E₂ : List (Σ j, F (.inr j)) → Prop} {k : ℕ} (h₁ : ∀ xs, xs ≠ [] → xs.length ≤ k → E₁ xs) (h₂ : ∀ xs, xs ≠ [] → xs.length ≤ k → E₂ xs) : @@ -409,7 +409,7 @@ theorem parallelInputs_of_length_le {I J : Type} {F : I ⊕ J → Type} · exact Or.inr (h₂ _ he (by omega)) /-- The queries at a left label of a parallel history are those of its left projection. -/ -theorem restrict_restrict_sumAlphabet {I J : Type} {F : I ⊕ J → Type} (i : I) +lemma restrict_restrict_sumAlphabet {I J : Type} {F : I ⊕ J → Type} (i : I) (ys : List (Σ l, F l)) : restrict i (restrict none (ys.map (sumAlphabet F).symm)) = restrict (Sum.inl i) ys := by induction ys with @@ -427,7 +427,7 @@ theorem restrict_restrict_sumAlphabet {I J : Type} {F : I ⊕ J → Type} (i : I ys.map (sumAlphabet F).symm)) = restrict (Sum.inl i) (⟨Sum.inr j, x⟩ :: ys) rw [restrict_cons_ne (by simp), restrict_cons_ne (by simp), ih] -theorem parallelInputs_nonempty_prefix {I J : Type} {F : I ⊕ J → Type} +lemma parallelInputs_nonempty_prefix {I J : Type} {F : I ⊕ J → Type} {E₁ : List (Σ i, F (.inl i)) → Prop} {E₂ : List (Σ j, F (.inr j)) → Prop} (hE₁ : ∀ {p h}, p <+: h → p ≠ [] → E₁ h → E₁ p) (hE₂ : ∀ {p h}, p <+: h → p ≠ [] → E₂ h → E₂ p) : ¬ parallelInputs E₁ E₂ [] ∧ @@ -448,14 +448,14 @@ end TensorDomain /-! ## Parallel and serial wiring -/ -theorem tensorRaw_mono {O O' J J' : Type} {U V : O ⊕ O' → Type} {X Y : J ⊕ J' → Type} +lemma tensorRaw_mono {O O' J J' : Type} {U V : O ⊕ O' → Type} {X Y : J ⊕ J' → Type} {a a' : InsideOutsideSystem O J (U ∘ Sum.inl) (V ∘ Sum.inl) (X ∘ Sum.inl) (Y ∘ Sum.inl)} {b b' : InsideOutsideSystem O' J' (U ∘ Sum.inr) (V ∘ Sum.inr) (X ∘ Sum.inr) (Y ∘ Sum.inr)} (ha : ∀ h y, y ∈ a h → y ∈ a' h) (hb : ∀ h y, y ∈ b h → y ∈ b' h) : ∀ h y, y ∈ tensorRaw a b h → y ∈ tensorRaw a' b' h := relabel_mono (pair_mono ha hb) _ _ -theorem Replies.serialM_mono {O M J : Type} {U V : O → Type} +lemma Replies.serialM_mono {O M J : Type} {U V : O → Type} {Xm Ym : M → Type} {X Y : J → Type} {a a' : InsideOutsideSystem O M U V Xm Ym} {b b' : InsideOutsideSystem M J Xm Ym X Y} (ha : ∀ h y, y ∈ a h → y ∈ a' h) (hb : ∀ h y, y ∈ b h → y ∈ b' h) @@ -467,7 +467,7 @@ section TensorWiring variable {O O' J J' : Type} {U V : O ⊕ O' → Type} {Xi Yi : J ⊕ J' → Type} /-- Parallel wiring respects equality of completed component histories. -/ -theorem replies_tensorRaw_congr +lemma replies_tensorRaw_congr {a a' : InsideOutsideSystem O J (U ∘ Sum.inl) (V ∘ Sum.inl) (Xi ∘ Sum.inl) (Yi ∘ Sum.inl)} {b b' : InsideOutsideSystem O' J' (U ∘ Sum.inr) (V ∘ Sum.inr) (Xi ∘ Sum.inr) (Yi ∘ Sum.inr)} (ha : ∀ xs ys, Replies a xs ys ↔ Replies a' xs ys) @@ -480,7 +480,7 @@ theorem replies_tensorRaw_congr rw [replies_tensorRaw_iff, replies_tensorRaw_iff, ha, hb] /-- **Canonical restriction commutes with parallel wiring** on admitted histories. -/ -theorem replies_tensorRaw_canon_iff {bP bQ : ℕ} +lemma replies_tensorRaw_canon_iff {bP bQ : ℕ} {P : InsideOutsideSystem O J (U ∘ Sum.inl) (V ∘ Sum.inl) (Xi ∘ Sum.inl) (Yi ∘ Sum.inl)} {Q : InsideOutsideSystem O' J' (U ∘ Sum.inr) (V ∘ Sum.inr) (Xi ∘ Sum.inr) (Yi ∘ Sum.inr)} (hP : IsDDC bP (canon P)) (hQ : IsDDC bQ (canon Q)) : @@ -546,7 +546,7 @@ variable {O O' M M' J J' : Type} {U V : O ⊕ O' → Type} {ba bb bc bd : ℕ} /-- Serial and parallel composition of partial converters satisfy interchange. -/ -theorem IsDDC.trim_serialM_tensorL (ha : IsDDC ba a) (hb : IsDDC bb b) +lemma IsDDC.trim_serialM_tensorL (ha : IsDDC ba a) (hb : IsDDC bb b) (hc : IsDDC bc c) (hd : IsDDC bd d) : trim (serialM (SystemAlgebra.tensorL a b) (SystemAlgebra.tensorL c d)) = SystemAlgebra.tensorL (trim (serialM a c)) (trim (serialM b d)) := by @@ -602,7 +602,7 @@ noncomputable def tensorPDC {bα bβ : ℕ} /-- On admitted joint transcripts, the parallel composition of presentations has the product of the component behaviors. -/ -theorem behaviorMass_tensorPDC {bα bβ : ℕ} +lemma behaviorMass_tensorPDC {bα bβ : ℕ} {R : RandomSystem (Σ l, twoFam U₁ Y₁ l) (Σ l, twoFam V₁ X₁ l) (Domain.converter E₁ m₁ hE₁ F₁ n₁ hF₁)} {S : RandomSystem (Σ l, twoFam U₂ Y₂ l) (Σ l, twoFam V₂ X₂ l) @@ -655,7 +655,7 @@ noncomputable def tensor (α : PDCBehavior O J U₁ V₁ X₁ Y₁ E₁ m₁ hE ofPDC (tensorPDC α.2.choose_spec.choose β.2.choose_spec.choose) /-- **The parallel composition of presentations presents the parallel composition.** -/ -theorem tensor_presents (α : PDCBehavior O J U₁ V₁ X₁ Y₁ E₁ m₁ hE₁ F₁ n₁ hF₁) +lemma tensor_presents (α : PDCBehavior O J U₁ V₁ X₁ Y₁ E₁ m₁ hE₁ F₁ n₁ hF₁) (β : PDCBehavior O' J' U₂ V₂ X₂ Y₂ E₂ m₂ hE₂ F₂ n₂ hF₂) {bα bβ : ℕ} (P : Distribution.ProbDist {a : InsideOutsideSystem O J U₁ V₁ X₁ Y₁ // IsDDCFrom E₁ F₁ bα a}) (Q : Distribution.ProbDist {b : InsideOutsideSystem O' J' U₂ V₂ X₂ Y₂ // IsDDCFrom E₂ F₂ bβ b}) @@ -670,7 +670,7 @@ theorem tensor_presents (α : PDCBehavior O J U₁ V₁ X₁ Y₁ E₁ m₁ hE /-- The parallel composition of two DDCs as behaviors is the behavior of their parallel composition. -/ -theorem tensor_ofDDC {a : InsideOutsideSystem O J U₁ V₁ X₁ Y₁} +lemma tensor_ofDDC {a : InsideOutsideSystem O J U₁ V₁ X₁ Y₁} {c : InsideOutsideSystem O' J' U₂ V₂ X₂ Y₂} {bα bβ : ℕ} (ha : IsDDCFrom E₁ F₁ bα a) (hc : IsDDCFrom E₂ F₂ bβ c) : tensor (ofDDC a ha : PDCBehavior O J U₁ V₁ X₁ Y₁ E₁ m₁ hE₁ F₁ n₁ hF₁) @@ -702,7 +702,7 @@ variable {J J' : Type} [Fintype J] [Fintype J'] {X₁ Y₁ : J → Type} {X₂ Y /-- **The parallel composition of the identities** from `E₁` to `E₁` and from `E₂` to `E₂` is the identity from `E₁ ∥ E₂` to `E₁ ∥ E₂`. -/ -theorem PDCBehavior.tensor_id (hE₁' : ¬ E₁ [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E₁ h → E₁ p) +lemma PDCBehavior.tensor_id (hE₁' : ¬ E₁ [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E₁ h → E₁ p) (hE₂' : ¬ E₂ [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E₂ h → E₂ p) : PDCBehavior.tensor (PDCBehavior.id (Y := Y₁) (m := m₁) (hE := hE₁) hE₁') (PDCBehavior.id (Y := Y₂) (m := m₂) (hE := hE₂) hE₂') = @@ -779,14 +779,14 @@ end Interchange /-- Trimming either constituent preserves the completed parallel behavior. -/ -theorem trim_pair_trim {A B C D : Type} (s : System A B) (t : System C D) : +lemma trim_pair_trim {A B C D : Type} (s : System A B) (t : System C D) : trim (pair (trim s) (trim t)) = trim (pair s t) := by apply EqOnReachable.trim_eq · exact EqOnReachable.parAll (fun k => by cases k <;> exact trim_behEq _) · exact Part.not_none_dom · exact Part.not_none_dom -theorem RepliesAtQueriedInterface.trim {I : Type} {X Y : I → Type} {R : InterfaceSystem I X Y} +lemma RepliesAtQueriedInterface.trim {I : Type} {X Y : I → Type} {R : InterfaceSystem I X Y} (hR : RepliesAtQueriedInterface R) : RepliesAtQueriedInterface (SystemAlgebra.trim R) := by intro h x y hy unfold SystemAlgebra.trim at hy @@ -795,7 +795,7 @@ theorem RepliesAtQueriedInterface.trim {I : Type} {X Y : I → Type} {R : Interf · exact (Part.not_none_dom hy.1).elim /-- The component tag and its original interface label both accompany the reply. -/ -theorem RepliesAtQueriedInterface.parallel {I J : Type} {X Y : I ⊕ J → Type} +lemma RepliesAtQueriedInterface.parallel {I J : Type} {X Y : I ⊕ J → Type} {R : InterfaceSystem I (X ∘ Sum.inl) (Y ∘ Sum.inl)} {S : InterfaceSystem J (X ∘ Sum.inr) (Y ∘ Sum.inr)} (hR : RepliesAtQueriedInterface R) (hS : RepliesAtQueriedInterface S) : @@ -823,7 +823,7 @@ variable {O O' J J' : Type} {U V : O ⊕ O' → Type} {X Y : J ⊕ J' → Type} {ba bb : ℕ} /-- Each converter interacts only with its own component. -/ -theorem apply_tensorRaw_pair (ha : IsDDC ba α) (hb : IsDDC bb β) +lemma apply_tensorRaw_pair (ha : IsDDC ba α) (hb : IsDDC bb β) (R : InterfaceSystem J (X ∘ Sum.inl) (Y ∘ Sum.inl)) (S : InterfaceSystem J' (X ∘ Sum.inr) (Y ∘ Sum.inr)) : apply (tensorRaw α β) (relabel (pair R S) (sumAlphabet X).symm (sumAlphabet Y)) = @@ -844,7 +844,7 @@ theorem apply_tensorRaw_pair (ha : IsDDC ba α) (hb : IsDDC bb β) rcases z with ⟨(i | j), z⟩ <;> rfl /-- The canonical tensor has the same completed partial behavior. -/ -theorem trim_apply_tensorL_pair (ha : IsDDC ba α) (hb : IsDDC bb β) +lemma trim_apply_tensorL_pair (ha : IsDDC ba α) (hb : IsDDC bb β) {R : InterfaceSystem J (X ∘ Sum.inl) (Y ∘ Sum.inl)} {S : InterfaceSystem J' (X ∘ Sum.inr) (Y ∘ Sum.inr)} (hR : RepliesAtQueriedInterface R) (hS : RepliesAtQueriedInterface S) : diff --git a/src/RandomSystems/Converter/EmptyInterface.lean b/src/RandomSystems/Converter/EmptyInterface.lean index 5948866..748cc4e 100644 --- a/src/RandomSystems/Converter/EmptyInterface.lean +++ b/src/RandomSystems/Converter/EmptyInterface.lean @@ -59,14 +59,14 @@ def resourceDDC (s : InterfaceSystem O U V) : InsideOutsideSystem O Empty U V Empty.elim Empty.elim := relabel s (outsideInput U) (outsideOutput V).symm -theorem not_isInside_unit (y : Σ l : Two O Empty, twoFam V (Empty.elim : Empty → Type) l) : +lemma not_isInside_unit (y : Σ l : Two O Empty, twoFam V (Empty.elim : Empty → Type) l) : ¬ IsInside y := by intro hy rcases y with ⟨⟨_ | ⟨⟨⟩⟩, j⟩, _⟩ · simp [IsInside] at hy · exact j.elim -theorem resourceDDC_isDDC {s : InterfaceSystem O U V} (hs : IsDDS s) +lemma resourceDDC_isDDC {s : InterfaceSystem O U V} (hs : IsDDS s) (hr : RepliesAtQueriedInterface s) : IsDDC 0 (resourceDDC s) where dds := ⟨by simpa [SilentAtEmpty, resourceDDC, relabel] using hs.1, fun l₁ l₂ hp hne hd => by @@ -98,7 +98,7 @@ theorem resourceDDC_isDDC {s : InterfaceSystem O U V} (hs : IsDDS s) · exact i.elim /-- Attaching a system with no inside interface reads the system itself. -/ -theorem apply_resourceDDC (s : InterfaceSystem O U V) (hs : SilentAtEmpty s) +lemma apply_resourceDDC (s : InterfaceSystem O U V) (hs : SilentAtEmpty s) (t : InterfaceSystem Empty Empty.elim Empty.elim) : apply (resourceDDC s) t = s := by let g : Two (Σ l : Two O Empty, twoFam V (Empty.elim : Empty → Type) l) @@ -130,7 +130,7 @@ theorem apply_resourceDDC (s : InterfaceSystem O U V) (hs : SilentAtEmpty s) exact Part.map_id' (fun _ => rfl) _ /-- With no inside labels, the outside inputs are all inputs. -/ -theorem outsideInputs_unit (xs : List (Σ l : Two O Empty, twoFam U (Empty.elim : Empty → Type) l)) : +lemma outsideInputs_unit (xs : List (Σ l : Two O Empty, twoFam U (Empty.elim : Empty → Type) l)) : outsideInputs xs = xs.map (outsideInput U) := by induction xs with | nil => rfl @@ -141,7 +141,7 @@ theorem outsideInputs_unit (xs : List (Σ l : Two O Empty, twoFam U (Empty.elim · exact i.elim /-- With no inside labels, there are no inside queries. -/ -theorem insideQueries_unit (ys : List (Σ l : Two O Empty, twoFam V (Empty.elim : Empty → Type) l)) : +lemma insideQueries_unit (ys : List (Σ l : Two O Empty, twoFam V (Empty.elim : Empty → Type) l)) : insideQueries ys = [] := by induction ys with | nil => rfl @@ -152,7 +152,7 @@ theorem insideQueries_unit (ys : List (Σ l : Two O Empty, twoFam V (Empty.elim · exact i.elim /-- With no inside labels, every outside query is admitted after every transcript. -/ -theorem converterAdmits_unit +lemma converterAdmits_unit (h : List ((Σ l : Two O Empty, twoFam U (Empty.elim : Empty → Type) l) × (Σ l : Two O Empty, twoFam V (Empty.elim : Empty → Type) l))) (x : Σ l : Two O Empty, twoFam U (Empty.elim : Empty → Type) l) : @@ -164,7 +164,7 @@ theorem converterAdmits_unit /-- The DDC reading of a deterministic system that answers exactly on `F` is a DDC from the empty domain to `F`. -/ -theorem resourceDDC_isDDCFrom {F : List (Σ o, U o) → Prop} {s : InterfaceSystem O U V} +lemma resourceDDC_isDDCFrom {F : List (Σ o, U o) → Prop} {s : InterfaceSystem O U V} (hs : IsDDS s) (hr : RepliesAtQueriedInterface s) (hd : ∀ h, (s h).Dom ↔ F h) : IsDDCFrom (fun _ => False) F 0 (resourceDDC s) where isDDC := resourceDDC_isDDC hs hr @@ -194,13 +194,13 @@ def discardSystem (J : Type) (X Y : J → Type) : InsideOutsideSystem Empty J Empty.elim Empty.elim X Y := fun _ => Part.none -theorem discardSystem_isDDC (J : Type) (X Y : J → Type) : IsDDC 0 (discardSystem J X Y) where +lemma discardSystem_isDDC (J : Type) (X Y : J → Type) : IsDDC 0 (discardSystem J X Y) where dds := ⟨Part.not_none_dom, fun _ _ _ _ hd => (Part.not_none_dom hd).elim⟩ admits _ _ hd := (Part.not_none_dom hd).elim bound _ hd := (Part.not_none_dom hd).elim replies _ _ _ hy := (Part.notMem_none _ hy).elim -theorem discardSystem_isDDCFrom {J : Type} {X Y : J → Type} (E : List (Σ j, X j) → Prop) : +lemma discardSystem_isDDCFrom {J : Type} {X Y : J → Type} (E : List (Σ j, X j) → Prop) : IsDDCFrom E (fun _ => False) 0 (discardSystem J X Y) where isDDC := discardSystem_isDDC J X Y answers h x _ := by diff --git a/src/RandomSystems/Converter/FilterAttachment.lean b/src/RandomSystems/Converter/FilterAttachment.lean index 6ffeda7..bc254b5 100644 --- a/src/RandomSystems/Converter/FilterAttachment.lean +++ b/src/RandomSystems/Converter/FilterAttachment.lean @@ -22,7 +22,7 @@ variable {O J : Type} {U V : O → Type} {X Y : J → Type} {α : InsideOutsideSystem O J U V X Y} {R : InterfaceSystem J X Y} /-- Internal exchanges append no outside query to the converter's history. -/ -theorem Exchange.outsideInputs_resource {G out H} +lemma Exchange.outsideInputs_resource {G out H} (ex : Exchange (pair α R) resourceRoute G out H) : outsideInputs (restrict none H) = outsideInputs (restrict none G) := by induction ex with @@ -40,7 +40,7 @@ theorem Exchange.outsideInputs_resource {G out H} simp [outsideInputs, List.map_append, splitIn] /-- The converter sees exactly the exposed input history at its outside ports. -/ -theorem Induces.outsideInputs_resource {us out H} +lemma Induces.outsideInputs_resource {us out H} (hi : Induces (pair α R) resourceRoute resourceInput us out H) : outsideInputs (restrict none H) = us := by induction hi with @@ -51,7 +51,7 @@ theorem Induces.outsideInputs_resource {us out H} congrArg (fun h => h ++ [u]) ih /-- A successful filtered call must lie in the retained outside domain. -/ -theorem apply_filterDom_dom +lemma apply_filterDom_dom (D : List (Σ o, U o) → Prop) {us : List (Σ o, U o)} (hd : (apply (filterDom (fun h => D (outsideInputs h)) α) R us).Dom) : D us := by rw [apply_eq] at hd @@ -86,7 +86,7 @@ theorem apply_filterDom_dom /-- Along an induced history whose exposed queries lie in a domain closed under nonempty prefixes, the converter restricted to that outside domain acts as the converter. -/ -theorem Induces.pair_filterDom_outside (F : List (Σ o, U o) → Prop) +lemma Induces.pair_filterDom_outside (F : List (Σ o, U o) → Prop) (hF : ∀ {p h}, p <+: h → p ≠ [] → F h → F p) {α' : InsideOutsideSystem O J U V X Y} {us o H} (hi : Induces (pair α' R) resourceRoute resourceInput us o H) (hu : F us) : ∀ p, p <+: H → pair (filterDom (fun h => outsideInputs h = [] ∨ F (outsideInputs h)) α) R p = @@ -111,7 +111,7 @@ theorem Induces.pair_filterDom_outside (F : List (Σ o, U o) → Prop) /-- **Restricting a converter's outside domain restricts its attachment**, for a domain closed under nonempty prefixes. -/ -theorem apply_filterDom_outside (F : List (Σ o, U o) → Prop) +lemma apply_filterDom_outside (F : List (Σ o, U o) → Prop) (hF : ∀ {p h}, p <+: h → p ≠ [] → F h → F p) : apply (filterDom (fun h => outsideInputs h = [] ∨ F (outsideInputs h)) α) R = filterDom F (apply α R) := by @@ -135,7 +135,7 @@ theorem apply_filterDom_outside (F : List (Σ o, U o) → Prop) /-- Forwarding through a filter is exactly domain restriction, including undefined behavior. The proof reuses identity attachment on admitted prefixes. -/ -theorem trim_apply_filter (D : List (Σ j, X j) → Prop) +lemma trim_apply_filter (D : List (Σ j, X j) → Prop) (hD : ∀ {p h}, p <+: h → D h → D p) {R : InterfaceSystem J X Y} (hR : IsDDS R) (hr : RepliesAtQueriedInterface R) : trim (apply (DDC.filter (Y := Y) D hD).1 R) = filterDom D R := by @@ -191,7 +191,7 @@ theorem trim_apply_filter (D : List (Σ j, X j) → Prop) namespace DDC /-- The DDS-level action of the forwarding filter is the same restriction. -/ -theorem filter_attach (D : List (Σ j, X j) → Prop) +lemma filter_attach (D : List (Σ j, X j) → Prop) (hD : ∀ {p h}, p <+: h → D h → D p) (R : DDS (Σ j, X j) (Σ j, Y j)) (hR : RepliesAtQueriedInterface R.1) : attach (filter D hD) R = DDS.filterDom D (fun hp _ => hD hp) R := by diff --git a/src/RandomSystems/Converter/Identity.lean b/src/RandomSystems/Converter/Identity.lean index cd4a167..8ec449a 100644 --- a/src/RandomSystems/Converter/Identity.lean +++ b/src/RandomSystems/Converter/Identity.lean @@ -22,7 +22,7 @@ namespace SystemAlgebra open Classical -theorem pair_mono {A B C D : Type} {s s' : System A B} {t t' : System C D} +lemma pair_mono {A B C D : Type} {s s' : System A B} {t t' : System C D} (hs : ∀ h y, y ∈ s h → y ∈ s' h) (ht : ∀ h y, y ∈ t h → y ∈ t' h) : ∀ h y, y ∈ pair s t h → y ∈ pair s' t' h := by intro h y hy @@ -39,7 +39,7 @@ variable {O J : Type} {U V : O → Type} {X Y : J → Type} /-- Responsiveness fixes the domain once preceding replies agree; therefore inclusion of complete converter behavior already gives equality. -/ -theorem IsResponsiveDDC.eq_of_replies_imp {b c : ℕ} {α β : InsideOutsideSystem O J U V X Y} +lemma IsResponsiveDDC.eq_of_replies_imp {b c : ℕ} {α β : InsideOutsideSystem O J U V X Y} (hα : IsResponsiveDDC b α) (hβ : IsResponsiveDDC c β) (he : ∀ xs ys, Replies α xs ys → Replies β xs ys) : α = β := by have key : ∀ h, α h = β h ∧ (Admissible α h ↔ Admissible β h) := by @@ -67,13 +67,13 @@ theorem IsResponsiveDDC.eq_of_replies_imp {b c : ℕ} {α β : InsideOutsideSyst (hd.mpr (Part.dom_iff_mem.mpr ⟨y, hy⟩)))⟩) exact funext (fun h => (key h).1) -theorem canon_mem {α : InsideOutsideSystem O J U V X Y} {h y} (hy : y ∈ canon α h) : y ∈ α h := by +lemma canon_mem {α : InsideOutsideSystem O J U V X Y} {h y} (hy : y ∈ canon α h) : y ∈ α h := by unfold canon at hy split_ifs at hy with ha · exact hy · simp at hy -theorem forwardAll_heterogeneous : +lemma forwardAll_heterogeneous : Forwarder (forwardAll J X Y) (fun | ⟨⟨none, j⟩, x⟩ => ⟨⟨some (), j⟩, x⟩ | ⟨⟨some (), j⟩, y⟩ => ⟨⟨none, j⟩, y⟩) := by @@ -82,7 +82,7 @@ theorem forwardAll_heterogeneous : · exact forwardAll_snoc_outer h j v · exact forwardAll_snoc_inner h j v -theorem serialM_forwardAll {α : InsideOutsideSystem O J U V X Y} (hα : SilentAtEmpty α) : +lemma serialM_forwardAll {α : InsideOutsideSystem O J U V X Y} (hα : SilentAtEmpty α) : serialM α (forwardAll J X Y) = α := by unfold serialM rw [interconnect_forwarder hα forwardAll_heterogeneous (f := id) (g := id), relabel_id] @@ -94,7 +94,7 @@ theorem serialM_forwardAll {α : InsideOutsideSystem O J U V X Y} (hα : SilentA · exact Or.inl rfl · exact Or.inr ⟨_, rfl, rfl⟩ -theorem forwardAll_serialM {α : InsideOutsideSystem O J U V X Y} (hα : SilentAtEmpty α) : +lemma forwardAll_serialM {α : InsideOutsideSystem O J U V X Y} (hα : SilentAtEmpty α) : serialM (forwardAll O U V) α = α := by unfold serialM rw [pair_swap, interconnect_relabel, @@ -107,7 +107,7 @@ theorem forwardAll_serialM {α : InsideOutsideSystem O J U V X Y} (hα : SilentA · exact Or.inr ⟨_, rfl, rfl⟩ · exact Or.inl rfl -theorem trim_serialM_id {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsResponsiveDDC b α) : +lemma trim_serialM_id {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsResponsiveDDC b α) : trim (serialM α (idConverter J X Y)) = α := by apply (hα.comp (idConverter_isResponsiveDDC ..)).eq_of_replies_imp hα intro xs ys hr @@ -116,7 +116,7 @@ theorem trim_serialM_id {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : change Replies (serialM α (forwardAll J X Y)) xs ys at hr' rwa [serialM_forwardAll hα.dds.1] at hr' -theorem trim_id_serialM {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsResponsiveDDC b α) : +lemma trim_id_serialM {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsResponsiveDDC b α) : trim (serialM (idConverter O U V) α) = α := by apply ((idConverter_isResponsiveDDC ..).comp hα).eq_of_replies_imp hα intro xs ys hr @@ -126,7 +126,7 @@ theorem trim_id_serialM {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : rwa [forwardAll_serialM hα.dds.1] at hr' /-- Equal completed replies identify every function value on their input prefixes. -/ -theorem IsResponsiveDDC.prefix_eq_of_replies {b c : ℕ} {α β : InsideOutsideSystem O J U V X Y} +lemma IsResponsiveDDC.prefix_eq_of_replies {b c : ℕ} {α β : InsideOutsideSystem O J U V X Y} (hα : IsResponsiveDDC b α) (hβ : IsResponsiveDDC c β) {xs ys} (hr : Replies α xs ys) (hr' : Replies β xs ys) : ∀ p, p <+: xs → α p = β p := by @@ -145,7 +145,7 @@ theorem IsResponsiveDDC.prefix_eq_of_replies {b c : ℕ} {α β : InsideOutsideS /-- A finite input sequence is determined by one finite completed converter history. If a query is illegal, agreement up to that query also determines all later undefined prefixes, by prefix closure and responsiveness. -/ -theorem IsResponsiveDDC.exists_prefix_test {b : ℕ} {α : InsideOutsideSystem O J U V X Y} +lemma IsResponsiveDDC.exists_prefix_test {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsResponsiveDDC b α) (H : List (Σ l, twoFam U Y l)) : ∃ xs ys, xs <+: H ∧ Replies α xs ys ∧ ∀ {c : ℕ} {β : InsideOutsideSystem O J U V X Y}, IsResponsiveDDC c β → Replies β xs ys → diff --git a/src/RandomSystems/Converter/PDCBehavior.lean b/src/RandomSystems/Converter/PDCBehavior.lean index 05e8e8a..126a6b7 100644 --- a/src/RandomSystems/Converter/PDCBehavior.lean +++ b/src/RandomSystems/Converter/PDCBehavior.lean @@ -41,7 +41,7 @@ instance instFintypeTwoFam {I J : Type} {F : I → Type} {G : J → Type} [∀ i | ⟨some (), j⟩ => (inferInstance : Fintype (G j)) /-- A reached history extends to a transcript. -/ -theorem Reach.exists_transcript {A B : Type} {s : System A B} {xs : List A} (hr : Reach s xs) : +lemma Reach.exists_transcript {A B : Type} {s : System A B} {xs : List A} (hr : Reach s xs) : ∃ t : List (A × B), t.map Prod.fst = xs ∧ Replies s (t.map Prod.fst) (t.map Prod.snd) := by obtain ⟨ys, hy⟩ := hr.exists_replies have hx : (xs.zip ys).map Prod.fst = xs := List.map_fst_zip (by rw [hy.length]) @@ -75,7 +75,7 @@ variable {E : List (Σ j, X j) → Prop} {m : ℕ} {hE : ∀ h, E h → h.length /-- **Every realization of a possible choice of a PDC behavior is a DDC from `E` to `F`** with its bound: its transcripts are those of the samples of a presentation. -/ -theorem IsPDCBehavior.isDDCFrom_realization {b : ℕ} +lemma IsPDCBehavior.isDDCFrom_realization {b : ℕ} {R : RandomSystem (Σ l, twoFam U Y l) (Σ l, twoFam V X l) (Domain.converter E m hE F n hF)} (hR : IsPDCBehavior O J U V X Y E m hE F n hF b R) {g} (hg : R.2.isSubprobabilistic.PossibleChoice g) : @@ -121,7 +121,7 @@ theorem IsPDCBehavior.isDDCFrom_realization {b : ℕ} discipline is the behavior of a PDC from `E` to `F`**: at most `b` inside queries between outside replies, every outside reply at the last outside label, and the inside queries in `E`. The samples are the realizations of its possible choices. -/ -theorem isPDCBehavior_of_transcripts {b : ℕ} +lemma isPDCBehavior_of_transcripts {b : ℕ} (R : RandomSystem (Σ l, twoFam U Y l) (Σ l, twoFam V X l) (Domain.converter E m hE F n hF)) (hbound : ∀ p e, R (p ++ e) ≠ 0 → (∀ z ∈ e, IsInside z.2) → e.length ≤ b) (hreply : ∀ h x y (o : O), R (h ++ [(x, y)]) ≠ 0 → y.1 = ⟨none, o⟩ → @@ -161,7 +161,7 @@ theorem isPDCBehavior_of_transcripts {b : ℕ} namespace PDCBehavior -@[ext] theorem ext {α β : PDCBehavior O J U V X Y E m hE F n hF} (h : ∀ t, α.1 t = β.1 t) : +@[ext] lemma ext {α β : PDCBehavior O J U V X Y E m hE F n hF} (h : ∀ t, α.1 t = β.1 t) : α = β := Subtype.ext (RandomSystem.ext h) @@ -177,7 +177,7 @@ noncomputable def ofDDC (a : InsideOutsideSystem O J U V X Y) {b : ℕ} (ha : Is ofPDC ⟨Finsupp.single ⟨a, ha⟩ 1, Distribution.isProbDist_single _⟩ /-- **A DDC's behavior** gives probability one to its transcripts and zero to all others. -/ -theorem ofDDC_apply (a : InsideOutsideSystem O J U V X Y) {b : ℕ} (ha : IsDDCFrom E F b a) +lemma ofDDC_apply (a : InsideOutsideSystem O J U V X Y) {b : ℕ} (ha : IsDDCFrom E F b a) (t : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))) : (ofDDC a ha : PDCBehavior O J U V X Y E m hE F n hF).1 t = if Replies a (t.map Prod.fst) (t.map Prod.snd) then 1 else 0 := by @@ -185,7 +185,7 @@ theorem ofDDC_apply (a : InsideOutsideSystem O J U V X Y) {b : ℕ} (ha : IsDDCF simp only [behaviorMass, Distribution.mass_single] /-- **Two DDCs from `E` to `F` below one system have the same behavior.** -/ -theorem ofDDC_eq_of_le {a c W : InsideOutsideSystem O J U V X Y} {b b' : ℕ} +lemma ofDDC_eq_of_le {a c W : InsideOutsideSystem O J U V X Y} {b b' : ℕ} (ha : IsDDCFrom E F b a) (hc : IsDDCFrom E F b' c) (haW : ∀ xs ys, Replies a xs ys → Replies W xs ys) (hcW : ∀ xs ys, Replies c xs ys → Replies W xs ys) : @@ -216,7 +216,7 @@ noncomputable def compPDC {bβ bα : ℕ} omit [Fintype O] [Fintype J] [∀ o, Fintype (U o)] [∀ o, Fintype (V o)] [∀ j, Fintype (X j)] [∀ j, Fintype (Y j)] [Fintype M] [∀ k, Fintype (Xm k)] [∀ k, Fintype (Ym k)] in -theorem behaviorMass_compPDC {bβ bα : ℕ} +lemma behaviorMass_compPDC {bβ bα : ℕ} (P : Distribution.ProbDist {a : InsideOutsideSystem O M U V Xm Ym // IsDDCFrom F' G bβ a}) (Q : Distribution.ProbDist {c : InsideOutsideSystem M J Xm Ym X Y // IsDDCFrom E F' bα c}) (h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))) : @@ -227,7 +227,7 @@ theorem behaviorMass_compPDC {bβ bα : ℕ} omit [Fintype O] [Fintype J] [∀ o, Fintype (U o)] [∀ o, Fintype (V o)] [∀ j, Fintype (X j)] [∀ j, Fintype (Y j)] [Fintype M] [∀ k, Fintype (Xm k)] [∀ k, Fintype (Ym k)] in -theorem serial_bound {b : ℕ} {a : InsideOutsideSystem O M U V Xm Ym} (ha : IsDDC b a) +lemma serial_bound {b : ℕ} {a : InsideOutsideSystem O M U V Xm Ym} (ha : IsDDC b a) (c : InsideOutsideSystem M J Xm Ym X Y) (us xs ys) (tr : Transcript (pair a c) (connectionQueries serialRouteM serialInjM us) xs ys) (hd : ¬ (connectionQueries serialRouteM serialInjM us ys).Dom) : @@ -236,7 +236,7 @@ theorem serial_bound {b : ℕ} {a : InsideOutsideSystem O M U V Xm Ym} (ha : IsD /-- On presentations, the serial connection law is the behavior of the composed PDC, for any valid internal bound `c`. -/ -theorem serial_connectionLaw +lemma serial_connectionLaw {R : RandomSystem (Σ l, twoFam U Ym l) (Σ l, twoFam V Xm l) (Domain.converter F' n' hF' G q hG)} {S : RandomSystem (Σ l, twoFam Xm Y l) (Σ l, twoFam Ym X l) (Domain.converter E m hE F' n' hF')} {bβ bα c : ℕ} (hc : IsPDCBehavior O M U V Xm Ym F' n' hF' G q hG c R) @@ -286,7 +286,7 @@ noncomputable def comp (β : PDCBehavior O M U V Xm Ym F' n' hF' G q hG) α.2.choose_spec.choose_spec h).symm⟩ /-- **The composition of presentations presents the composition.** -/ -theorem comp_presents (β : PDCBehavior O M U V Xm Ym F' n' hF' G q hG) +lemma comp_presents (β : PDCBehavior O M U V Xm Ym F' n' hF' G q hG) (α : PDCBehavior M J Xm Ym X Y E m hE F' n' hF') {bβ bα : ℕ} (P : Distribution.ProbDist {a : InsideOutsideSystem O M U V Xm Ym // IsDDCFrom F' G bβ a}) (Q : Distribution.ProbDist {c : InsideOutsideSystem M J Xm Ym X Y // IsDDCFrom E F' bα c}) @@ -297,7 +297,7 @@ theorem comp_presents (β : PDCBehavior O M U V Xm Ym F' n' hF' G q hG) serial_connectionLaw β.2.choose_spec P Q hP hQ h /-- The composition of two DDCs as behaviors is the behavior of their composition. -/ -theorem comp_ofDDC {a : InsideOutsideSystem O M U V Xm Ym} {c : InsideOutsideSystem M J Xm Ym X Y} +lemma comp_ofDDC {a : InsideOutsideSystem O M U V Xm Ym} {c : InsideOutsideSystem M J Xm Ym X Y} {bβ bα : ℕ} (ha : IsDDCFrom F' G bβ a) (hc : IsDDCFrom E F' bα c) : comp (ofDDC a ha : PDCBehavior O M U V Xm Ym F' n' hF' G q hG) (ofDDC c hc : PDCBehavior M J Xm Ym X Y E m hE F' n' hF') = @@ -311,7 +311,7 @@ theorem comp_ofDDC {a : InsideOutsideSystem O M U V Xm Ym} {c : InsideOutsideSys simp only [behaviorMass, Distribution.mass_single] /-- Composing after a DDC: the behavior is the mass of the composed samples. -/ -theorem ofDDC_comp_presents {a : InsideOutsideSystem O M U V Xm Ym} {bβ bα : ℕ} +lemma ofDDC_comp_presents {a : InsideOutsideSystem O M U V Xm Ym} {bβ bα : ℕ} (ha : IsDDCFrom F' G bβ a) (α : PDCBehavior M J Xm Ym X Y E m hE F' n' hF') (Q : Distribution.ProbDist {c : InsideOutsideSystem M J Xm Ym X Y // IsDDCFrom E F' bα c}) (hQ : ∀ h, behaviorMass Q.1 (h.map Prod.fst) (h.map Prod.snd) = α.1 h) @@ -323,7 +323,7 @@ theorem ofDDC_comp_presents {a : InsideOutsideSystem O M U V Xm Ym} {bβ bα : Distribution.mass_fTransform] /-- Composing before a DDC: the behavior is the mass of the composed samples. -/ -theorem comp_ofDDC_presents (β : PDCBehavior O M U V Xm Ym F' n' hF' G q hG) {bβ bα : ℕ} +lemma comp_ofDDC_presents (β : PDCBehavior O M U V Xm Ym F' n' hF' G q hG) {bβ bα : ℕ} (P : Distribution.ProbDist {a : InsideOutsideSystem O M U V Xm Ym // IsDDCFrom F' G bβ a}) (hP : ∀ h, behaviorMass P.1 (h.map Prod.fst) (h.map Prod.snd) = β.1 h) {c : InsideOutsideSystem M J Xm Ym X Y} (hc : IsDDCFrom E F' bα c) @@ -335,7 +335,7 @@ theorem comp_ofDDC_presents (β : PDCBehavior O M U V Xm Ym F' n' hF' G q hG) {b Distribution.mass_fTransform] /-- Serial composition is associative. -/ -theorem comp_assoc {L : Type} [Fintype L] {XL YL : L → Type} [∀ k, Fintype (XL k)] +lemma comp_assoc {L : Type} [Fintype L] {XL YL : L → Type} [∀ k, Fintype (XL k)] [∀ k, Fintype (YL k)] {F'' : List (Σ k, XL k) → Prop} {n'' : ℕ} {hF'' : ∀ h, F'' h → h.length ≤ n''} (γ : PDCBehavior O L U V XL YL F'' n'' hF'' G q hG) (β : PDCBehavior L M XL YL Xm Ym F' n' hF' F'' n'' hF'') @@ -372,7 +372,7 @@ protected noncomputable def id (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [ variable {M : Type} [Fintype M] {Xm Ym : M → Type} [∀ k, Fintype (Xm k)] [∀ k, Fintype (Ym k)] -theorem comp_id (α : PDCBehavior O J U V X Y E m hE F n hF) +lemma comp_id (α : PDCBehavior O J U V X Y E m hE F n hF) (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) : comp α (PDCBehavior.id (m := m) (hE := hE) hE') = α := by obtain ⟨b, P, hP⟩ := α.2 @@ -382,7 +382,7 @@ theorem comp_id (α : PDCBehavior O J U V X Y E m hE F n hF) Distribution.prod_single_right, Distribution.mass_fTransform, ← hP] exact Distribution.mass_congr _ (fun s => s.2.replies_serialM_filter hE' h) -theorem id_comp (α : PDCBehavior O J U V X Y E m hE F n hF) +lemma id_comp (α : PDCBehavior O J U V X Y E m hE F n hF) (hF' : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] → F h → F p) : comp (PDCBehavior.id (m := n) (hE := hF) hF') α = α := by obtain ⟨b, P, hP⟩ := α.2 diff --git a/src/RandomSystems/Converter/ParallelPDS.lean b/src/RandomSystems/Converter/ParallelPDS.lean index 76ff154..ba99aa9 100644 --- a/src/RandomSystems/Converter/ParallelPDS.lean +++ b/src/RandomSystems/Converter/ParallelPDS.lean @@ -34,7 +34,7 @@ variable {I J : Type} {X₁ Y₁ : I → Type} {X₂ Y₂ : J → Type} {E : List (Σ i, X₁ i) → Prop} {F : List (Σ j, X₂ j) → Prop} /-- The exact domain of the parallel composition of two DDSs. -/ -theorem parallel_system_dom {S : InterfaceSystem I X₁ Y₁} {T : InterfaceSystem J X₂ Y₂} +lemma parallel_system_dom {S : InterfaceSystem I X₁ Y₁} {T : InterfaceSystem J X₂ Y₂} (hS : IsDDS S) (hT : IsDDS T) (hdS : ∀ h, (S h).Dom ↔ E h) (hdT : ∀ h, (T h).Dom ↔ F h) (h : List (Σ l, Sum.rec X₁ X₂ l)) : (relabel (trim (pair S T)) (sumAlphabet (Sum.rec X₁ X₂)).symm @@ -59,7 +59,7 @@ theorem parallel_system_dom {S : InterfaceSystem I X₁ Y₁} {T : InterfaceSyst /-- The parallel composition of two deterministic resources is a deterministic resource with the parallel domain. -/ -theorem parallel_system_valid {s : InterfaceSystem I X₁ Y₁} {t : InterfaceSystem J X₂ Y₂} +lemma parallel_system_valid {s : InterfaceSystem I X₁ Y₁} {t : InterfaceSystem J X₂ Y₂} (hs : IsDDS s ∧ RepliesAtQueriedInterface s ∧ ∀ h, (s h).Dom ↔ E h) (ht : IsDDS t ∧ RepliesAtQueriedInterface t ∧ ∀ h, (t h).Dom ↔ F h) : let r := relabel (trim (pair s t)) (sumAlphabet (Sum.rec X₁ X₂)).symm @@ -99,7 +99,7 @@ def parallelStep : S × T → (l : I ⊕ J) → Sum.rec X₁ X₂ l → (S × T) | (a, b), .inr j, x => ((a, (g b j x).1), (g b j x).2) /-- Side by side, each automaton reaches the state of its own inputs. -/ -theorem stateAfter_parallelStep (a : S) (b : T) (h : List (Σ l, Sum.rec X₁ X₂ l)) : +lemma stateAfter_parallelStep (a : S) (b : T) (h : List (Σ l, Sum.rec X₁ X₂ l)) : stateAfter (parallelStep f g) (a, b) h = (stateAfter f a (restrict none (h.map (sumAlphabet (Sum.rec X₁ X₂)).symm)), stateAfter g b (restrict (some ()) (h.map (sumAlphabet (Sum.rec X₁ X₂)).symm))) := by @@ -113,7 +113,7 @@ theorem stateAfter_parallelStep (a : S) (b : T) (h : List (Σ l, Sum.rec X₁ X · simp [parallelStep, sumAlphabet, stateAfter_snoc, restrict_cons_ne] /-- Bisimulations side by side are a bisimulation. -/ -theorem parallelStep_bisim {S' T' : Type} {f' : S' → (i : I) → X₁ i → S' × Y₁ i} +lemma parallelStep_bisim {S' T' : Type} {f' : S' → (i : I) → X₁ i → S' × Y₁ i} {g' : T' → (j : J) → X₂ j → T' × Y₂ j} {R : S → S' → Prop} {R' : T → T' → Prop} (hf : IsBisim f f' R) (hg : IsBisim g g' R') : IsBisim (parallelStep f g) (parallelStep f' g') (fun a a' => R a.1 a'.1 ∧ R' a.2 a'.2) := by @@ -124,7 +124,7 @@ theorem parallelStep_bisim {S' T' : Type} {f' : S' → (i : I) → X₁ i → S' exact ⟨h₁, ha, h₂⟩ /-- An automaton's reply to an input after a history is determined by its system. -/ -theorem step_reply_eq_of_system_eq {K S' S'' : Type} {Z W : K → Type} +lemma step_reply_eq_of_system_eq {K S' S'' : Type} {Z W : K → Type} {f₁ : S' → (k : K) → Z k → S' × W k} {f₂ : S'' → (k : K) → Z k → S'' × W k} {a₁ : S'} {a₂ : S''} (h : automatonSystem f₁ a₁ = automatonSystem f₂ a₂) (hs : List (Σ k, Z k)) (x : Σ k, Z k) : (f₁ (stateAfter f₁ a₁ hs) x.1 x.2).2 = (f₂ (stateAfter f₂ a₂ hs) x.1 x.2).2 := by @@ -133,7 +133,7 @@ theorem step_reply_eq_of_system_eq {K S' S'' : Type} {Z W : K → Type} exact eq_of_heq (Sigma.mk.inj e).2 /-- Side by side, automata with the same systems have the same system. -/ -theorem parallelStep_congr {S' T' : Type} {f' : S' → (i : I) → X₁ i → S' × Y₁ i} +lemma parallelStep_congr {S' T' : Type} {f' : S' → (i : I) → X₁ i → S' × Y₁ i} {g' : T' → (j : J) → X₂ j → T' × Y₂ j} {a : S} {b : T} {a' : S'} {b' : T'} (hf : automatonSystem f a = automatonSystem f' a') (hg : automatonSystem g b = automatonSystem g' b') : @@ -151,7 +151,7 @@ theorem parallelStep_congr {S' T' : Type} {f' : S' → (i : I) → X₁ i → S' /-- **Two automata on domains, in parallel**, are the automaton running both side by side, on the parallel domain. -/ -theorem parallel_automatonSystem (hE : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) +lemma parallel_automatonSystem (hE : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) (hF : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] → F h → F p) (a : S) (b : T) : relabel (trim (pair (filterDom E (automatonSystem f a)) (filterDom F (automatonSystem g b)))) (sumAlphabet (Sum.rec X₁ X₂)).symm (sumAlphabet (Sum.rec Y₁ Y₂)) = diff --git a/src/RandomSystems/Converter/PartialConverter.lean b/src/RandomSystems/Converter/PartialConverter.lean index 6b6f572..9b6f96d 100644 --- a/src/RandomSystems/Converter/PartialConverter.lean +++ b/src/RandomSystems/Converter/PartialConverter.lean @@ -26,7 +26,7 @@ open Classical variable {O J : Type} {U V : O → Type} {X Y : J → Type} /-- A prefix-closed restriction changes no replies or query bound. -/ -theorem IsDDC.filterDom {b : ℕ} {α : InsideOutsideSystem O J U V X Y} +lemma IsDDC.filterDom {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) (D : List (Σ l, twoFam U Y l) → Prop) (hD : ∀ {p h}, p <+: h → p ≠ [] → D h → D p) : IsDDC b (filterDom D α) := by @@ -47,7 +47,7 @@ theorem IsDDC.filterDom {b : ℕ} {α : InsideOutsideSystem O J U V X Y} exact hα.replies h y o ((filterDom_mem_iff D α h y).mp hy).2 ho /-- Only the finite internal-query bound is needed for attachment to converge. -/ -theorem IsDDC.converges_along {I : Type} {Xi Yi : I → Type} +lemma IsDDC.converges_along {I : Type} {Xi Yi : I → Type} {ι : J → I} {α : InsideOutsideSystem O J U V (Xi ∘ ι) (Yi ∘ ι)} {b : ℕ} (hα : IsDDC b α) (R : InterfaceSystem I Xi Yi) : Converges (pair α R) (alongRoute ι) (alongInj ι) := @@ -57,7 +57,7 @@ theorem IsDDC.converges_along {I : Type} {Xi Yi : I → Type} noncomputable def outsideInputs (h : List (Σ l, twoFam U Y l)) : List (Σ o, U o) := restrict none (h.map splitIn) -theorem outsideInputs_append (h e : List (Σ l, twoFam U Y l)) : +lemma outsideInputs_append (h e : List (Σ l, twoFam U Y l)) : outsideInputs (h ++ e) = outsideInputs h ++ outsideInputs e := by simp only [outsideInputs, List.map_append, restrict_append] diff --git a/src/RandomSystems/Converter/PartialIdentity.lean b/src/RandomSystems/Converter/PartialIdentity.lean index 648b512..480cdc6 100644 --- a/src/RandomSystems/Converter/PartialIdentity.lean +++ b/src/RandomSystems/Converter/PartialIdentity.lean @@ -22,7 +22,7 @@ open Classical variable {O J : Type} {U V : O → Type} {X Y : J → Type} /-- The last reply of a completed history fixes the reply label. -/ -theorem Replies.replyLabel_eq {α : InsideOutsideSystem O J U V X Y} (hα : SilentAtEmpty α) {us ys} +lemma Replies.replyLabel_eq {α : InsideOutsideSystem O J U V X Y} (hα : SilentAtEmpty α) {us ys} (hr : Replies α us ys) : SystemAlgebra.replyLabel α us = ys.getLast?.map (·.1) := by rcases List.eq_nil_or_concat us with rfl | ⟨us, a, rfl⟩ · have hy : ys = [] := List.length_eq_zero_iff.mp hr.length @@ -36,7 +36,7 @@ theorem Replies.replyLabel_eq {α : InsideOutsideSystem O J U V X Y} (hα : Sile simp /-- A completed history restricted to its first `k + 1` exchanges is completed. -/ -theorem Replies.take {A B : Type} {s : System A B} {xs : List A} {ys : List B} +lemma Replies.take {A B : Type} {s : System A B} {xs : List A} {ys : List B} (hr : Replies s xs ys) (k : ℕ) : Replies s (xs.take (k + 1)) (ys.take (k + 1)) := by refine ⟨by simp [hr.length], fun i hi hi' => ?_⟩ simp only [List.length_take] at hi hi' @@ -46,7 +46,7 @@ theorem Replies.take {A B : Type} {s : System A B} {xs : List A} {ys : List B} /-- Completed histories are those whose every prefix has the corresponding exposed run. -/ -theorem replies_interconnect_of_runs {A B X' Y' : Type} {s : System X' Y'} +lemma replies_interconnect_of_runs {A B X' Y' : Type} {s : System X' Y'} {route : Y' → B ⊕ X'} {inj : A → X'} {us : List A} {ys : List B} (hl : ys.length = us.length) (hrun : ∀ k (hk : k < us.length) (hj : k < ys.length), @@ -56,7 +56,7 @@ theorem replies_interconnect_of_runs {A B X' Y' : Type} {s : System X' Y'} obtain ⟨H, hi⟩ := hrun k hk hj exact Part.eq_some_iff.mpr (mem_interconnect.mpr ⟨H, hi⟩) -theorem getLast?_take_succ {A : Type} {ys : List A} {k : ℕ} (hk : k < ys.length) : +lemma getLast?_take_succ {A : Type} {ys : List A} {k : ℕ} (hk : k < ys.length) : (ys.take (k + 1)).getLast? = some ys[k] := by have he : ys.take (k + 1) = ys.take k ++ [ys[k]] := by rw [List.take_add_one, List.getElem?_eq_getElem hk]; rfl @@ -64,7 +64,7 @@ theorem getLast?_take_succ {A : Type} {ys : List A} {k : ℕ} (hk : k < ys.lengt rfl /-- The identity forwards an outside query of an idle history. -/ -theorem idConverter_query {h : List (Σ l, twoFam X Y l)} +lemma idConverter_query {h : List (Σ l, twoFam X Y l)} (hi : Idle (idConverter J X Y) h) (j : J) (x : X j) : idConverter J X Y (h ++ [⟨⟨none, j⟩, x⟩]) = Part.some ⟨⟨some (), j⟩, x⟩ := by have ha : Admissible (idConverter J X Y) (h ++ [⟨⟨none, j⟩, x⟩]) := @@ -72,17 +72,17 @@ theorem idConverter_query {h : List (Σ l, twoFam X Y l)} rw [idConverter, canon_of_admissible ((admissible_canon_iff _).mp ha)] exact forwardAll_snoc_outer h j x -theorem admitAfter_none_iff {P Q : Type} {r : Option (Two P Q)} {l : P} : +lemma admitAfter_none_iff {P Q : Type} {r : Option (Two P Q)} {l : P} : admitAfter r ⟨none, l⟩ ↔ ∀ j, r ≠ some ⟨some (), j⟩ := by rcases r with _ | ⟨_ | ⟨⟨⟩⟩, l'⟩ <;> simp [admitAfter] -theorem admitAfter_some_iff {P Q : Type} {r : Option (Two P Q)} {j : Q} : +lemma admitAfter_some_iff {P Q : Type} {r : Option (Two P Q)} {j : Q} : admitAfter r ⟨some (), j⟩ ↔ r = some ⟨some (), j⟩ := by rcases r with _ | ⟨_ | ⟨⟨⟩⟩, l'⟩ <;> simp [admitAfter, eq_comm] /-- Composing on the inside with the identity reproduces every completed history of a partial converter. -/ -theorem IsDDC.replies_serialM_id {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) +lemma IsDDC.replies_serialM_id {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) {us ys} (hr : Replies α us ys) : Replies (serialM α (idConverter J X Y)) us ys := by have key : ∀ us ys, Replies α us ys → ∃ H, Induces (pair α (idConverter J X Y)) serialRouteM serialInjM us ys.getLast? H ∧ @@ -197,7 +197,7 @@ theorem IsDDC.replies_serialM_id {b : ℕ} {α : InsideOutsideSystem O J U V X Y /-- Composing on the outside with the identity reproduces every completed history of a partial converter. The identity's history alternates each outside call and the reply returned for it. -/ -theorem IsDDC.replies_id_serialM {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) +lemma IsDDC.replies_id_serialM {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) {us ys} (hr : Replies α us ys) : Replies (serialM (idConverter O U V) α) us ys := by have key : ∀ us ys, Replies α us ys → ∃ H, Induces (pair (idConverter O U V) α) serialRouteM serialInjM us ys.getLast? H ∧ @@ -326,7 +326,7 @@ theorem IsDDC.replies_id_serialM {b : ℕ} {α : InsideOutsideSystem O J U V X Y exact ⟨H, hi⟩ /-- The identity is a right unit for partial converters. -/ -theorem IsDDC.trim_serialM_id {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) : +lemma IsDDC.trim_serialM_id {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) : trim (serialM α (idConverter J X Y)) = α := by apply IsDDS.eq_of_replies_iff (SilentAtEmpty.isDDS_trim (by simp [SilentAtEmpty, serialM])) hα.dds intro xs ys @@ -339,7 +339,7 @@ theorem IsDDC.trim_serialM_id {b : ℕ} {α : InsideOutsideSystem O J U V X Y} ( · exact hα.replies_serialM_id /-- The identity is a left unit for partial converters. -/ -theorem IsDDC.trim_id_serialM {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) : +lemma IsDDC.trim_id_serialM {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) : trim (serialM (idConverter O U V) α) = α := by apply IsDDS.eq_of_replies_iff (SilentAtEmpty.isDDS_trim (by simp [SilentAtEmpty, serialM])) hα.dds intro xs ys diff --git a/src/RandomSystems/Converter/Program.lean b/src/RandomSystems/Converter/Program.lean index 85a87e6..80a3e72 100644 --- a/src/RandomSystems/Converter/Program.lean +++ b/src/RandomSystems/Converter/Program.lean @@ -70,10 +70,10 @@ abbrev Consistent (P : Program S O J U V X Y) (s : S) (o : O) (u : U o) : def Bounded (b : ℕ) (P : Program S O J U V X Y) : Prop := ∀ s o u, CallBound b (P s o u) -theorem consistent_nil (P : Program S O J U V X Y) (s : S) (o : O) (u : U o) : +lemma consistent_nil (P : Program S O J U V X Y) (s : S) (o : O) (u : U o) : P.Consistent s o u [] := fun i hi => absurd hi (Nat.not_lt_zero i) -theorem Consistent.snoc {P : Program S O J U V X Y} {s : S} {o : O} {u : U o} +lemma Consistent.snoc {P : Program S O J U V X Y} {s : S} {o : O} {u : U o} {h : List ((Σ j, X j) × (Σ j, Y j))} (hc : P.Consistent s o u h) {q : Σ j, X j} (hq : P s o u h = .inr q) (v : Y q.1) : P.Consistent s o u (h ++ [(q, ⟨q.1, v⟩)]) := by intro i hi @@ -85,7 +85,7 @@ theorem Consistent.snoc {P : Program S O J U V X Y} {s : S} {o : O} {u : U o} simpa using hq /-- **A bounded program's own exchanges** in one invocation number at most its bound. -/ -theorem Consistent.length_le {P : Program S O J U V X Y} {b : ℕ} (hP : P.Bounded b) {s : S} {o : O} +lemma Consistent.length_le {P : Program S O J U V X Y} {b : ℕ} (hP : P.Bounded b) {s : S} {o : O} {u : U o} {h : List ((Σ j, X j) × (Σ j, Y j))} (hc : P.Consistent s o u h) : h.length ≤ b := by -- Either `h` is empty, or it is earlier exchanges `h'` followed by a last exchange `z`. rcases List.eq_nil_or_concat h with rfl | ⟨h', z, rfl⟩ @@ -194,36 +194,36 @@ def Mode.Sound (P : Program S O J U V X Y) : Mode S O J U X Y → Prop variable (P : Program S O J U V X Y) -@[simp] theorem run_nil (m : Option (Mode S O J U X Y)) : P.run m [] = m := rfl +@[simp] lemma run_nil (m : Option (Mode S O J U X Y)) : P.run m [] = m := rfl -@[simp] theorem run_none (xs : List (Σ l, twoFam U Y l)) : P.run none xs = none := by +@[simp] lemma run_none (xs : List (Σ l, twoFam U Y l)) : P.run none xs = none := by induction xs with | nil => rfl | cons x xs ih => exact ih -theorem run_append (m : Option (Mode S O J U X Y)) (xs ys : List (Σ l, twoFam U Y l)) : +lemma run_append (m : Option (Mode S O J U X Y)) (xs ys : List (Σ l, twoFam U Y l)) : P.run m (xs ++ ys) = P.run (P.run m xs) ys := by simp only [run, List.foldl_append] -theorem run_snoc (m : Option (Mode S O J U X Y)) (xs : List (Σ l, twoFam U Y l)) +lemma run_snoc (m : Option (Mode S O J U X Y)) (xs : List (Σ l, twoFam U Y l)) (x : Σ l, twoFam U Y l) : P.run m (xs ++ [x]) = (P.run m xs).bind fun m => (P.step m x).map Prod.fst := by rw [run_append]; rfl -@[simp] theorem after_nil (s : S) : P.after s [] = some (.idle s) := rfl +@[simp] lemma after_nil (s : S) : P.after s [] = some (.idle s) := rfl -theorem after_snoc (s : S) (xs : List (Σ l, twoFam U Y l)) (x : Σ l, twoFam U Y l) : +lemma after_snoc (s : S) (xs : List (Σ l, twoFam U Y l)) (x : Σ l, twoFam U Y l) : P.after s (xs ++ [x]) = (P.after s xs).bind fun m => (P.step m x).map Prod.fst := P.run_snoc _ xs x -theorem after_isSome_of_append (s : S) {xs ys : List (Σ l, twoFam U Y l)} +lemma after_isSome_of_append (s : S) {xs ys : List (Σ l, twoFam U Y l)} (h : (P.after s (xs ++ ys)).isSome) : (P.after s xs).isSome := by rw [after, run_append] at h cases hx : P.run (some (.idle s)) xs with | none => rw [hx, run_none] at h; exact absurd h (by simp) | some m => rw [after, hx]; rfl -theorem step_isSome_iff (m : Mode S O J U X Y) (z : Σ l, twoFam U Y l) : +lemma step_isSome_iff (m : Mode S O J U X Y) (z : Σ l, twoFam U Y l) : (P.step m z).isSome ↔ m.AdmitsLabel z.1 := by rcases m with s | ⟨o, s, u, h, q⟩ <;> rcases z with ⟨⟨_ | ⟨⟨⟩⟩, i⟩, x⟩ · simp [step, Mode.AdmitsLabel] @@ -234,7 +234,7 @@ theorem step_isSome_iff (m : Mode S O J U X Y) (z : Σ l, twoFam U Y l) : · simp [step, Mode.AdmitsLabel, hi] /-- After an output, the next admitted labels are those of the new mode. -/ -theorem admitAfter_emit (s : S) (o : O) (u : U o) (h : List ((Σ j, X j) × (Σ j, Y j))) +lemma admitAfter_emit (s : S) (o : O) (u : U o) (h : List ((Σ j, X j) × (Σ j, Y j))) (l : Two O J) : admitAfter (some (P.emit s o u h).2.1) l ↔ (P.emit s o u h).1.AdmitsLabel l := by unfold emit @@ -244,7 +244,7 @@ theorem admitAfter_emit (s : S) (o : O) (u : U o) (h : List ((Σ j, X j) × (Σ /-- A step starts an invocation from an idle mode on an outside query, or continues one on the reply to its pending query. -/ -theorem step_cases {m m' : Mode S O J U X Y} {z : Σ l, twoFam U Y l} {y : Σ l, twoFam V X l} +lemma step_cases {m m' : Mode S O J U X Y} {z : Σ l, twoFam U Y l} {y : Σ l, twoFam V X l} (hs : P.step m z = some (m', y)) : (∃ s o u, m = .idle s ∧ z = ⟨⟨none, o⟩, u⟩ ∧ (m', y) = P.emit s o u []) ∨ ∃ o s u h q, ∃ v : Y q.1, m = .busy o s u h q ∧ z = ⟨⟨some (), q.1⟩, v⟩ ∧ @@ -260,7 +260,7 @@ theorem step_cases {m m' : Mode S O J U X Y} {z : Σ l, twoFam U Y l} {y : Σ l, · simp [step, hi] at hs /-- The body's result determines the output and the mode. -/ -theorem emit_cases (s : S) (o : O) (u : U o) (h : List ((Σ j, X j) × (Σ j, Y j))) : +lemma emit_cases (s : S) (o : O) (u : U o) (h : List ((Σ j, X j) × (Σ j, Y j))) : (∃ s' v, P s o u h = .inl (s', v) ∧ P.emit s o u h = (.idle s', ⟨⟨none, o⟩, v⟩)) ∨ ∃ q, P s o u h = .inr q ∧ P.emit s o u h = (.busy o s u h q, ⟨⟨some (), q.1⟩, q.2⟩) := by unfold emit @@ -268,7 +268,7 @@ theorem emit_cases (s : S) (o : O) (u : U o) (h : List ((Σ j, X j) × (Σ j, Y | inl a => exact Or.inl ⟨a.1, a.2, rfl, rfl⟩ | inr q => exact Or.inr ⟨q, rfl, rfl⟩ -theorem after_snoc_eq_some (s : S) (xs : List (Σ l, twoFam U Y l)) (x : Σ l, twoFam U Y l) +lemma after_snoc_eq_some (s : S) (xs : List (Σ l, twoFam U Y l)) (x : Σ l, twoFam U Y l) (m' : Mode S O J U X Y) : P.after s (xs ++ [x]) = some m' ↔ ∃ m y, P.after s xs = some m ∧ P.step m x = some (m', y) := by @@ -292,9 +292,9 @@ namespace DDC variable (s : S) (P : Program S O J U V X Y) -@[simp] theorem ofProgram_nil : DDC.ofProgram s P [] = Part.none := rfl +@[simp] lemma ofProgram_nil : DDC.ofProgram s P [] = Part.none := rfl -theorem mem_ofProgram_snoc (xs : List (Σ l, twoFam U Y l)) (x : Σ l, twoFam U Y l) +lemma mem_ofProgram_snoc (xs : List (Σ l, twoFam U Y l)) (x : Σ l, twoFam U Y l) (y : Σ l, twoFam V X l) : y ∈ DDC.ofProgram s P (xs ++ [x]) ↔ ∃ m m', P.after s xs = some m ∧ P.step m x = some (m', y) := by @@ -307,13 +307,13 @@ theorem mem_ofProgram_snoc (xs : List (Σ l, twoFam U Y l)) (x : Σ l, twoFam U | none => simp | some r => simp [eq_comm] -theorem ofProgram_snoc (xs : List (Σ l, twoFam U Y l)) (x : Σ l, twoFam U Y l) : +lemma ofProgram_snoc (xs : List (Σ l, twoFam U Y l)) (x : Σ l, twoFam U Y l) : DDC.ofProgram s P (xs ++ [x]) = Part.ofOption ((P.after s xs).bind fun m => (P.step m x).map Prod.snd) := by simp [DDC.ofProgram] /-- **The converter answers exactly the inputs its run admits.** -/ -theorem ofProgram_dom (xs : List (Σ l, twoFam U Y l)) : +lemma ofProgram_dom (xs : List (Σ l, twoFam U Y l)) : (DDC.ofProgram s P xs).Dom ↔ xs ≠ [] ∧ (P.after s xs).isSome := by rcases List.eq_nil_or_concat xs with rfl | ⟨xs, x, rfl⟩ · simp @@ -327,7 +327,7 @@ theorem ofProgram_dom (xs : List (Σ l, twoFam U Y l)) : variable {s P} /-- The reply to an admitted history is the output of its last step. -/ -theorem ofProgram_mem_iff {xs : List (Σ l, twoFam U Y l)} {x : Σ l, twoFam U Y l} +lemma ofProgram_mem_iff {xs : List (Σ l, twoFam U Y l)} {x : Σ l, twoFam U Y l} {y y' : Σ l, twoFam V X l} (hy : y ∈ DDC.ofProgram s P (xs ++ [x])) : y' ∈ DDC.ofProgram s P (xs ++ [x]) ↔ y' = y := ⟨fun hy' => Part.mem_unique hy' hy, fun he => he ▸ hy⟩ @@ -335,7 +335,7 @@ theorem ofProgram_mem_iff {xs : List (Σ l, twoFam U Y l)} {x : Σ l, twoFam U Y /-- **Invariants of the run.** After an admitted history the mode waits for its body's query, counts the inside queries of the current invocation, knows that invocation's outside label, and admits exactly the labels the last reply admits. -/ -theorem after_invariant {xs : List (Σ l, twoFam U Y l)} {m : Program.Mode S O J U X Y} +lemma after_invariant {xs : List (Σ l, twoFam U Y l)} {m : Program.Mode S O J U X Y} (hm : P.after s xs = some m) : m.Sound P ∧ insideRun (DDC.ofProgram s P) xs = m.pending ∧ (∀ o, m.owner = some o → lastOuter xs = some o) ∧ @@ -457,7 +457,7 @@ theorem ofProgram_isResponsiveDDC {b : ℕ} (hP : P.Bounded b) : simp at hl /-- The mode after an admitted history of converter inputs. -/ -theorem after_of_replies {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} +lemma after_of_replies {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} (hr : Replies (DDC.ofProgram s P) (h.map Prod.fst) (h.map Prod.snd)) : ∃ m, P.after s (h.map Prod.fst) = some m := by by_cases hn : h.map Prod.fst = [] @@ -466,7 +466,7 @@ theorem after_of_replies {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l) /-- **A program making at most `b` inside queries per invocation** makes at most `b` inside queries per outside query along its transcripts. -/ -theorem insideQueries_length_le {b : ℕ} (hP : P.Bounded b) +lemma insideQueries_length_le {b : ℕ} (hP : P.Bounded b) {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} (hr : Replies (DDC.ofProgram s P) (h.map Prod.fst) (h.map Prod.snd)) : (insideQueries (h.map Prod.snd)).length ≤ b * (outsideInputs (h.map Prod.fst)).length := by @@ -534,7 +534,7 @@ theorem insideQueries_length_le {b : ℕ} (hP : P.Bounded b) /-- **A port-preserving program** makes, along its transcripts, at most as many inside queries at `j = ι o` as outside queries at `o`. -/ -theorem insideQueries_restrict_length_le {ι : O → Option J} (hP : P.PortPreserving ι) +lemma insideQueries_restrict_length_le {ι : O → Option J} (hP : P.PortPreserving ι) {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} (hr : Replies (DDC.ofProgram s P) (h.map Prod.fst) (h.map Prod.snd)) {o : O} {j : J} (hj : ι o = some j) : @@ -619,7 +619,7 @@ noncomputable def ofProgramOn (F : List (Σ o, U o) → Prop) : InsideOutsideSys /-- A transcript of the restricted converter is a transcript of the program whose outside queries lie in `F`. -/ -theorem replies_ofProgramOn {F : List (Σ o, U o) → Prop} +lemma replies_ofProgramOn {F : List (Σ o, U o) → Prop} {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} (hr : Replies (ofProgramOn s P F) (h.map Prod.fst) (h.map Prod.snd)) : Replies (DDC.ofProgram s P) (h.map Prod.fst) (h.map Prod.snd) ∧ @@ -631,7 +631,7 @@ theorem replies_ofProgramOn {F : List (Σ o, U o) → Prop} /-- **A bounded program on the outside domain `F`** is a DDC from `E` to `F` when the inside queries of its transcripts lie in `E`. -/ -theorem ofProgramOn_isDDCFrom {E : List (Σ j, X j) → Prop} {F : List (Σ o, U o) → Prop} +lemma ofProgramOn_isDDCFrom {E : List (Σ j, X j) → Prop} {F : List (Σ o, U o) → Prop} {b : ℕ} (hP : P.Bounded b) (hF : ∀ {p h}, p <+: h → p ≠ [] → F h → F p) (hq : ∀ h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l)), Replies (DDC.ofProgram s P) (h.map Prod.fst) (h.map Prod.snd) → @@ -643,7 +643,7 @@ theorem ofProgramOn_isDDCFrom {E : List (Σ j, X j) → Prop} {F : List (Σ o, U /-- **Budgets.** On outside histories of at most `q` queries, a program making at most `b` inside queries per invocation makes at most `b * q` inside queries. -/ -theorem insideQueries_length_le_of_budget {b q : ℕ} (hP : P.Bounded b) +lemma insideQueries_length_le_of_budget {b q : ℕ} (hP : P.Bounded b) {F : List (Σ o, U o) → Prop} (hFq : ∀ xs, F xs → xs.length ≤ q) {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} (hr : Replies (DDC.ofProgram s P) (h.map Prod.fst) (h.map Prod.snd)) @@ -656,7 +656,7 @@ theorem insideQueries_length_le_of_budget {b q : ℕ} (hP : P.Bounded b) /-- **Exact costs.** A program making exactly `cost u` inside queries on the outside query `u` makes at most the total cost of its outside queries along its transcripts. -/ -theorem insideQueries_length_le_of_costs {cost : (Σ o, U o) → ℕ} (hP : P.Costs cost) +lemma insideQueries_length_le_of_costs {cost : (Σ o, U o) → ℕ} (hP : P.Costs cost) {h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l))} (hr : Replies (DDC.ofProgram s P) (h.map Prod.fst) (h.map Prod.snd)) : (insideQueries (h.map Prod.snd)).length ≤ ((outsideInputs (h.map Prod.fst)).map cost).sum := by diff --git a/src/RandomSystems/Converter/ProgramAttachment.lean b/src/RandomSystems/Converter/ProgramAttachment.lean index 7541813..03c5007 100644 --- a/src/RandomSystems/Converter/ProgramAttachment.lean +++ b/src/RandomSystems/Converter/ProgramAttachment.lean @@ -60,7 +60,7 @@ variable {P r} history whose converter inputs leave the program in the mode `m` and whose resource inputs are `rh`, the input `x` leads to the reply `w`, and the internal history reached records the new mode and resource inputs. -/ -theorem exchange_of_feed (s : S) : +lemma exchange_of_feed (s : S) : ∀ (n : ℕ) (G : List (Two (Σ l, twoFam U Y l) (Σ j, X j))) (m : Mode S O J U X Y) (x : Σ l, twoFam U Y l) (rh : List (Σ j, X j)) (m' : Mode S O J U X Y) (rh' : List (Σ j, X j)) (w : Σ o, V o), @@ -110,7 +110,7 @@ def Dead (s : S) (G : List (Two (Σ l, twoFam U Y l) (Σ j, X j))) : Prop := ∀ m, P.after s (restrict none G) = some m → ∃ o s' u h q, m = .busy o s' u h q /-- A step producing an inside query counts one more inside query and keeps the mode sound. -/ -theorem step_inside {m m' : Mode S O J U X Y} {x : Σ l, twoFam U Y l} {j : J} {q : X j} +lemma step_inside {m m' : Mode S O J U X Y} {x : Σ l, twoFam U Y l} {j : J} {q : X j} (hm : m.Sound P) (hs : P.step m x = some (m', ⟨⟨some (), j⟩, q⟩)) : m'.pending = m.pending + 1 ∧ m'.Sound P := by rcases P.step_cases hs with ⟨s', o, u, rfl, rfl, he⟩ | ⟨o, s', u, h, q', v, rfl, rfl, he⟩ @@ -126,14 +126,14 @@ theorem step_inside {m m' : Mode S O J U X Y} {x : Σ l, twoFam U Y l} {j : J} { exact ⟨by simp [Mode.pending], hm.1.snoc hm.2 v, hq⟩ /-- A sound mode of a bounded program has made at most `b` inside queries. -/ -theorem pending_le {b : ℕ} (hP : P.Bounded b) {m : Mode S O J U X Y} (hm : m.Sound P) : +lemma pending_le {b : ℕ} (hP : P.Bounded b) {m : Mode S O J U X Y} (hm : m.Sound P) : m.pending ≤ b := by rcases m with s | ⟨o, s, u, h, q⟩ · exact Nat.zero_le _ · exact hP s o u h q hm.1 hm.2 /-- A step producing an outside reply leaves the program idle. -/ -theorem step_outside {m m' : Mode S O J U X Y} {x : Σ l, twoFam U Y l} {o : O} {v : V o} +lemma step_outside {m m' : Mode S O J U X Y} {x : Σ l, twoFam U Y l} {o : O} {v : V o} (hs : P.step m x = some (m', ⟨⟨none, o⟩, v⟩)) : ∃ s', m' = .idle s' := by rcases P.step_cases hs with ⟨s', o', u, rfl, rfl, he⟩ | ⟨o', s', u, h, q', v', rfl, rfl, he⟩ · rcases P.emit_cases s' o' u [] with ⟨s'', w, _, hE⟩ | ⟨q'', _, hE⟩ @@ -144,7 +144,7 @@ theorem step_outside {m m' : Mode S O J U X Y} {x : Σ l, twoFam U Y l} {o : O} · rw [hE] at he; cases (Prod.mk.inj he).2 /-- A completed invocation leaves the program idle. -/ -theorem feed_idle : +lemma feed_idle : ∀ (n : ℕ) (m : Mode S O J U X Y) (x : Σ l, twoFam U Y l) (rh : List (Σ j, X j)) (m' : Mode S O J U X Y) (rh' : List (Σ j, X j)) (w : Σ o, V o), P.feed r n m x rh = some (m', rh', w) → ∃ s', m' = .idle s' @@ -163,7 +163,7 @@ theorem feed_idle : /-- **An invocation that does not complete is a silent exchange**, after which the program admits no outside query. -/ -theorem exchange_of_feed_none (s : S) {b : ℕ} (hP : P.Bounded b) : +lemma exchange_of_feed_none (s : S) {b : ℕ} (hP : P.Bounded b) : ∀ (n : ℕ) (G : List (Two (Σ l, twoFam U Y l) (Σ j, X j))) (m : Mode S O J U X Y) (x : Σ l, twoFam U Y l) (rh : List (Σ j, X j)), P.after s (restrict none G) = some m → m.Sound P → b + 1 ≤ n + m.pending → @@ -226,7 +226,7 @@ theorem exchange_of_feed_none (s : S) {b : ℕ} (hP : P.Bounded b) : exact ⟨o', s', u, _, q'', (Prod.mk.inj he).1⟩ /-- From a dead internal history, every outside query is a silent exchange. -/ -theorem exchange_of_dead (s : S) {G : List (Two (Σ l, twoFam U Y l) (Σ j, X j))} +lemma exchange_of_dead (s : S) {G : List (Two (Σ l, twoFam U Y l) (Σ j, X j))} (hG : Dead P s G) (o : O) (u : U o) : Exchange (pair (DDC.ofProgram s P) r) resourceRoute (G ++ [⟨none, ⟨⟨none, o⟩, u⟩⟩]) none (G ++ [⟨none, ⟨⟨none, o⟩, u⟩⟩]) ∧ Dead P s (G ++ [⟨none, ⟨⟨none, o⟩, u⟩⟩]) := by @@ -259,21 +259,21 @@ noncomputable def inline (b : ℕ) (s : S) : InterfaceSystem O U V := fun us => Part.ofOption (us.getLast?.bind fun u => (P.inlineAfter r b s us.dropLast).bind fun mr => (P.feed r (b + 1) mr.1 ⟨⟨none, u.1⟩, u.2⟩ mr.2).map fun t => t.2.2) -@[simp] theorem inlineAfter_nil (b : ℕ) (s : S) : +@[simp] lemma inlineAfter_nil (b : ℕ) (s : S) : P.inlineAfter r b s [] = some (.idle s, []) := rfl -theorem inlineAfter_snoc (b : ℕ) (s : S) (us : List (Σ o, U o)) (u : Σ o, U o) : +lemma inlineAfter_snoc (b : ℕ) (s : S) (us : List (Σ o, U o)) (u : Σ o, U o) : P.inlineAfter r b s (us ++ [u]) = (P.inlineAfter r b s us).bind fun mr => (P.feed r (b + 1) mr.1 ⟨⟨none, u.1⟩, u.2⟩ mr.2).map fun t => (t.1, t.2.1) := by simp only [inlineAfter, List.foldl_append, List.foldl_cons, List.foldl_nil] -theorem inline_snoc (b : ℕ) (s : S) (us : List (Σ o, U o)) (u : Σ o, U o) : +lemma inline_snoc (b : ℕ) (s : S) (us : List (Σ o, U o)) (u : Σ o, U o) : P.inline r b s (us ++ [u]) = Part.ofOption ((P.inlineAfter r b s us).bind fun mr => (P.feed r (b + 1) mr.1 ⟨⟨none, u.1⟩, u.2⟩ mr.2).map fun t => t.2.2) := by simp [inline] /-- **The internal histories of the attachment follow the inlined program.** -/ -theorem induces_inline (s : S) {b : ℕ} (hP : P.Bounded b) : ∀ us : List (Σ o, U o), +lemma induces_inline (s : S) {b : ℕ} (hP : P.Bounded b) : ∀ us : List (Σ o, U o), (∀ m rh, P.inlineAfter r b s us = some (m, rh) → ∃ o H, Induces (pair (DDC.ofProgram s P) r) resourceRoute resourceInput us o H ∧ P.after s (restrict none H) = some m ∧ (∃ s', m = .idle s') ∧ @@ -346,7 +346,7 @@ theorem apply_ofProgram (s : S) {b : ℕ} (hP : P.Bounded b) : rw [interconnect_eq_some (Induces.snoc _ _ _ _ _ _ hi l)] simp [hf] -theorem inlineAfter_isSome_of_append (b : ℕ) (s : S) {us e : List (Σ o, U o)} +lemma inlineAfter_isSome_of_append (b : ℕ) (s : S) {us e : List (Σ o, U o)} (h : (P.inlineAfter r b s (us ++ e)).isSome) : (P.inlineAfter r b s us).isSome := by induction e using List.reverseRecOn with | nil => simpa using h @@ -357,7 +357,7 @@ theorem inlineAfter_isSome_of_append (b : ℕ) (s : S) {us e : List (Σ o, U o)} | none => rw [hst] at h; simp at h | some _ => rfl -theorem inline_dom (b : ℕ) (s : S) (us : List (Σ o, U o)) : +lemma inline_dom (b : ℕ) (s : S) (us : List (Σ o, U o)) : (P.inline r b s us).Dom ↔ us ≠ [] ∧ (P.inlineAfter r b s us).isSome := by rcases List.eq_nil_or_concat us with rfl | ⟨us, u, rfl⟩ · simp [inline] @@ -368,20 +368,20 @@ theorem inline_dom (b : ℕ) (s : S) (us : List (Σ o, U o)) : | none => simp | some mr => cases P.feed r (b + 1) mr.1 ⟨⟨none, u.1⟩, u.2⟩ mr.2 <;> simp -theorem inline_isDDS (b : ℕ) (s : S) : IsDDS (P.inline r b s) := by +lemma inline_isDDS (b : ℕ) (s : S) : IsDDS (P.inline r b s) := by refine ⟨by simp [SilentAtEmpty, inline], fun p h hp hne hd => ?_⟩ obtain ⟨e, rfl⟩ := hp rw [inline_dom] at hd ⊢ exact ⟨hne, inlineAfter_isSome_of_append b s hd.2⟩ /-- The attachment of a program, as a deterministic system, is the inlined program. -/ -theorem trim_apply_ofProgram (s : S) {b : ℕ} (hP : P.Bounded b) : +lemma trim_apply_ofProgram (s : S) {b : ℕ} (hP : P.Bounded b) : trim (apply (DDC.ofProgram s P) r) = P.inline r b s := by rw [apply_ofProgram s hP] exact (inline_isDDS b s).trim_eq /-- **Attaching the program on the outside domain `F`** is the inlined program on `F`. -/ -theorem trim_apply_ofProgramOn (s : S) {b : ℕ} (hP : P.Bounded b) (F : List (Σ o, U o) → Prop) +lemma trim_apply_ofProgramOn (s : S) {b : ℕ} (hP : P.Bounded b) (F : List (Σ o, U o) → Prop) (hF : ∀ {p h}, p <+: h → p ≠ [] → F h → F p) : trim (apply (DDC.ofProgramOn s P F) r) = filterDom F (P.inline r b s) := by rw [DDC.ofProgramOn, apply_filterDom_outside F hF, apply_ofProgram s hP] @@ -405,7 +405,7 @@ def invoke (s : S) (o : O) (u : U o) : | .inr q => invoke s o u n (stepR r q.1 q.2).1 (h ++ [(q, ⟨q.1, (stepR r q.1 q.2).2⟩)]) /-- A bounded program completes each invocation against an automaton. -/ -theorem invoke_isSome {b : ℕ} (hP : P.Bounded b) (s : S) (o : O) (u : U o) : +lemma invoke_isSome {b : ℕ} (hP : P.Bounded b) (s : S) (o : O) (u : U o) : ∀ n r h, P.Consistent s o u h → b ≤ n + h.length → (P.invoke stepR s o u n r h).isSome := by intro n @@ -431,7 +431,7 @@ noncomputable def combine {b : ℕ} (hP : P.Bounded b) : S × R → (o : O) → (invoke_isSome stepR hP sr.1 o u b sr.2 [] (consistent_nil P _ _ _) (by simp)) /-- More inside queries allowed do not change a completed invocation. -/ -theorem invoke_add {s : S} {o : O} {u : U o} {v : (S × R) × V o} : +lemma invoke_add {s : S} {o : O} {u : U o} {v : (S × R) × V o} : ∀ n r h k, P.invoke stepR s o u n r h = some v → P.invoke stepR s o u (n + k) r h = some v := by intro n induction n with @@ -452,12 +452,12 @@ theorem invoke_add {s : S} {o : O} {u : U o} {v : (S × R) × V o} : simp only [invoke, hq] at hv ⊢ exact ih _ _ k hv -theorem invoke_eq_combine {b : ℕ} (hP : P.Bounded b) (sr : S × R) (o : O) (u : U o) : +lemma invoke_eq_combine {b : ℕ} (hP : P.Bounded b) (sr : S × R) (o : O) (u : U o) : P.invoke stepR sr.1 o u b sr.2 [] = some (P.combine stepR hP sr o u) := by simp [combine] /-- The combined automaton answers as any invocation that completes. -/ -theorem combine_eq_of_invoke {b : ℕ} (hP : P.Bounded b) {sr : S × R} {o : O} {u : U o} {n : ℕ} +lemma combine_eq_of_invoke {b : ℕ} (hP : P.Bounded b) {sr : S × R} {o : O} {u : U o} {n : ℕ} {v : (S × R) × V o} (hv : P.invoke stepR sr.1 o u n sr.2 [] = some v) : P.combine stepR hP sr o u = v := by have h₁ := invoke_add stepR n sr.2 [] b hv @@ -467,7 +467,7 @@ theorem combine_eq_of_invoke {b : ℕ} (hP : P.Bounded b) {sr : S × R} {o : O} /-- Against bisimilar automata an invocation makes the same queries and replies, and leaves related states. -/ -theorem invoke_bisim {R' : Type} {stepR' : R' → (j : J) → X j → R' × Y j} {rel : R → R' → Prop} +lemma invoke_bisim {R' : Type} {stepR' : R' → (j : J) → X j → R' × Y j} {rel : R → R' → Prop} (hR : IsBisim stepR stepR' rel) (s : S) (o : O) (u : U o) : ∀ n r r' h, rel r r' → Option.Rel (fun a b => a.1.1 = b.1.1 ∧ rel a.1.2 b.1.2 ∧ a.2 = b.2) @@ -496,7 +496,7 @@ theorem invoke_bisim {R' : Type} {stepR' : R' → (j : J) → X j → R' × Y j} exact ih _ _ _ hr' /-- **Attaching a program to bisimilar automata** gives bisimilar automata. -/ -theorem combine_bisim {R' : Type} {stepR' : R' → (j : J) → X j → R' × Y j} {rel : R → R' → Prop} +lemma combine_bisim {R' : Type} {stepR' : R' → (j : J) → X j → R' × Y j} {rel : R → R' → Prop} (hR : IsBisim stepR stepR' rel) {b : ℕ} (hP : P.Bounded b) : IsBisim (P.combine stepR hP) (P.combine stepR' hP) (fun a a' => a.1 = a'.1 ∧ rel a.2 a'.2) := by rintro ⟨s, r⟩ ⟨s', r'⟩ o u ⟨rfl, hr⟩ @@ -506,7 +506,7 @@ theorem combine_bisim {R' : Type} {stepR' : R' → (j : J) → X j → R' × Y j exact ⟨h₃, h₁, h₂⟩ /-- An invocation fed by an automaton is the invocation against the automaton. -/ -theorem feed_automatonSystem (r₀ : R) : +lemma feed_automatonSystem (r₀ : R) : ∀ (n : ℕ) (s : S) (o : O) (u : U o) (h : List ((Σ j, X j) × (Σ j, Y j))) (rh : List (Σ j, X j)) (m : Mode S O J U X Y) (x : Σ l, twoFam U Y l), P.step m x = some (P.emit s o u h) → @@ -598,7 +598,7 @@ theorem inline_automatonSystem {b : ℕ} (hP : P.Bounded b) (s : S) (r₀ : R) : simp only [Option.map_some, Part.coe_some, hf.2.2] /-- Attached to automata with the same system, a program gives automata with the same system. -/ -theorem combine_congr {R' : Type} {stepR' : R' → (j : J) → X j → R' × Y j} {b : ℕ} +lemma combine_congr {R' : Type} {stepR' : R' → (j : J) → X j → R' × Y j} {b : ℕ} (hP : P.Bounded b) (s : S) {r₀ : R} {r₀' : R'} (h : automatonSystem stepR r₀ = automatonSystem stepR' r₀') : automatonSystem (P.combine stepR hP) (s, r₀) = automatonSystem (P.combine stepR' hP) (s, r₀') := by diff --git a/src/RandomSystems/Converter/ResourceAttachment.lean b/src/RandomSystems/Converter/ResourceAttachment.lean index b96981e..d0b1362 100644 --- a/src/RandomSystems/Converter/ResourceAttachment.lean +++ b/src/RandomSystems/Converter/ResourceAttachment.lean @@ -54,7 +54,7 @@ def allOutsideOutput : noncomputable def apply (α : InsideOutsideSystem O J U V X Y) (R : InterfaceSystem J X Y) : InterfaceSystem O U V := relabel (attachAlong id α R) allOutsideInput allOutsideOutput -theorem apply_eq (α : InsideOutsideSystem O J U V X Y) (R : InterfaceSystem J X Y) : +lemma apply_eq (α : InsideOutsideSystem O J U V X Y) (R : InterfaceSystem J X Y) : apply α R = interconnect (pair α R) resourceRoute resourceInput := by rw [apply, attachAlong_eq, relabel_interconnect] congr 1 @@ -67,7 +67,7 @@ theorem apply_eq (α : InsideOutsideSystem O J U V X Y) (R : InterfaceSystem J X exact congrArg (Sum.map allOutsideOutput id) (alongRoute_image (U := U) (V := V) id Function.injective_id j y) -theorem cyclesThrough_resource : +lemma cyclesThrough_resource : CyclesThrough (IsInside (F := twoFam V X)) (resourceRoute (U := U) (Y := Y)) := by refine ⟨?_, ?_, ?_⟩ · rintro ⟨⟨_ | ⟨⟨⟩⟩, i⟩, y⟩ hy @@ -79,18 +79,18 @@ theorem cyclesThrough_resource : · rintro ⟨j, y⟩ exact Or.inr ⟨_, rfl⟩ -theorem IsDDC.converges_resource {b : ℕ} {α : InsideOutsideSystem O J U V X Y} +lemma IsDDC.converges_resource {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsDDC b α) (R : InterfaceSystem J X Y) : Converges (pair α R) resourceRoute resourceInput := converges_pair cyclesThrough_resource hα.bound -theorem IsResponsiveDDC.converges_resource {b : ℕ} {α : InsideOutsideSystem O J U V X Y} +lemma IsResponsiveDDC.converges_resource {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsResponsiveDDC b α) (R : InterfaceSystem J X Y) : Converges (pair α R) resourceRoute resourceInput := hα.isDDC.converges_resource R /-- Regrouping connects the same three histories, including undefined behavior. -/ -theorem IsDDC.apply_serialM {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} +lemma IsDDC.apply_serialM {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} {α : InsideOutsideSystem M J Xm Ym X Y} (hβ : IsDDC bβ β) (hα : IsDDC bα α) (R : InterfaceSystem J X Y) : apply (serialM β α) R = apply β (apply α R) := by simp only [apply_eq, serialM] @@ -104,12 +104,12 @@ theorem IsDDC.apply_serialM {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm rcases y with ⟨⟨_ | ⟨⟨⟩⟩, i⟩, y⟩ <;> rfl · rcases y with ⟨j, y⟩; rfl -theorem apply_serialM {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} +lemma apply_serialM {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} {α : InsideOutsideSystem M J Xm Ym X Y} (hβ : IsResponsiveDDC bβ β) (hα : IsResponsiveDDC bα α) (R : InterfaceSystem J X Y) : apply (serialM β α) R = apply β (apply α R) := IsDDC.apply_serialM hβ.isDDC hα.isDDC R -theorem EqOnReachable.apply {α α' : InsideOutsideSystem O J U V X Y} {R R' : InterfaceSystem J X Y} +lemma EqOnReachable.apply {α α' : InsideOutsideSystem O J U V X Y} {R R' : InterfaceSystem J X Y} (hα : α ≈ₛ α') (hR : R ≈ₛ R') : apply α R ≈ₛ apply α' R' := by rw [apply_eq, apply_eq] apply EqOnReachable.interconnect @@ -118,7 +118,7 @@ theorem EqOnReachable.apply {α α' : InsideOutsideSystem O J U V X Y} {R R' : I | some _ => exact hR) /-- The serial resource equation on canonical partial systems. -/ -theorem IsDDC.trim_apply_serialM {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} +lemma IsDDC.trim_apply_serialM {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} {α : InsideOutsideSystem M J Xm Ym X Y} (hβ : IsDDC bβ β) (hα : IsDDC bα α) (R : InterfaceSystem J X Y) : trim (apply (trim (serialM β α)) R) = @@ -129,7 +129,7 @@ theorem IsDDC.trim_apply_serialM {bβ bα : ℕ} {β : InsideOutsideSystem O M U exact (hl.trans hr.symm).trim_eq (by simp [SilentAtEmpty, apply_eq]) (by simp [SilentAtEmpty, apply_eq]) -theorem trim_apply_serialM {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} +lemma trim_apply_serialM {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} {α : InsideOutsideSystem M J Xm Ym X Y} (hβ : IsResponsiveDDC bβ β) (hα : IsResponsiveDDC bα α) (R : InterfaceSystem J X Y) : trim (apply (trim (serialM β α)) R) = @@ -146,7 +146,7 @@ noncomputable def attach (α : DDC O J U V X Y) SilentAtEmpty.isDDS_trim (by simp [SilentAtEmpty, apply_eq])⟩ /-- Serial attachment on partial DDSs is the general system regrouping equation. -/ -theorem comp_attach (β : DDC O M U V Xm Ym) (α : DDC M J Xm Ym X Y) +lemma comp_attach (β : DDC O M U V Xm Ym) (α : DDC M J Xm Ym X Y) (R : DDS (Σ j, X j) (Σ j, Y j)) : attach (comp β α) R = attach β (attach α R) := by apply Subtype.ext @@ -157,7 +157,7 @@ theorem comp_attach (β : DDC O M U V Xm Ym) (α : DDC M J Xm Ym X Y) end DDC /-- One identity exchange forwards the query and reply at the same interface. -/ -theorem idConverter_call {h : List (Σ l, twoFam X Y l)} +lemma idConverter_call {h : List (Σ l, twoFam X Y l)} (hi : Idle (idConverter J X Y) h) (j : J) (x : X j) (y : Y j) : idConverter J X Y (h ++ [⟨⟨none, j⟩, x⟩]) = Part.some ⟨⟨some (), j⟩, x⟩ ∧ idConverter J X Y (h ++ [⟨⟨none, j⟩, x⟩, ⟨⟨some (), j⟩, y⟩]) = @@ -186,7 +186,7 @@ theorem idConverter_call {h : List (Σ l, twoFam X Y l)} simpa only [List.append_assoc, List.singleton_append] using hif /-- Every completed resource history is forwarded by the canonical identity. -/ -theorem replies_apply_id {R : InterfaceSystem J X Y} (hR : RepliesAtQueriedInterface R) +lemma replies_apply_id {R : InterfaceSystem J X Y} (hR : RepliesAtQueriedInterface R) {xs ys} (hr : Replies R xs ys) : Replies (apply (idConverter J X Y) R) xs ys := by have key : ∀ xs ys, Replies R xs ys → ∃ o H, Induces (pair (idConverter J X Y) R) resourceRoute resourceInput xs o H ∧ @@ -258,7 +258,7 @@ theorem replies_apply_id {R : InterfaceSystem J X Y} (hR : RepliesAtQueriedInter rw [ho _ hl] at hi exact Part.eq_some_iff.mpr (mem_interconnect.mpr ⟨H, hi⟩) -theorem apply_forwardAll {R : InterfaceSystem J X Y} (hR : SilentAtEmpty R) : +lemma apply_forwardAll {R : InterfaceSystem J X Y} (hR : SilentAtEmpty R) : apply (forwardAll J X Y) R = R := by rw [apply_eq, pair_swap, interconnect_relabel, interconnect_forwarder hR forwardAll_heterogeneous (f := id) (g := id), relabel_id] @@ -267,7 +267,7 @@ theorem apply_forwardAll {R : InterfaceSystem J X Y} (hR : SilentAtEmpty R) : · rintro ⟨j, y⟩; exact Or.inr ⟨_, rfl, rfl⟩ /-- Identity on a partial responding DDS, with its domain unchanged. -/ -theorem trim_apply_id {R : InterfaceSystem J X Y} (hR : IsDDS R) (hresp : RepliesAtQueriedInterface R) : +lemma trim_apply_id {R : InterfaceSystem J X Y} (hR : IsDDS R) (hresp : RepliesAtQueriedInterface R) : trim (apply (idConverter J X Y) R) = R := by apply IsDDS.eq_of_replies_iff (SilentAtEmpty.isDDS_trim (s := apply (idConverter J X Y) R) @@ -291,7 +291,7 @@ def MapsDomain (E : List (Σ j, X j) → Prop) (F : List (Σ o, U o) → Prop) RepliesAtQueriedInterface (trim (apply α R)) ∧ ∀ h, (trim (apply α R) h).Dom ↔ F h /-- Identity acts on every partial resource domain. -/ -theorem idConverter_mapsDomain (E : List (Σ j, X j) → Prop) : +lemma idConverter_mapsDomain (E : List (Σ j, X j) → Prop) : MapsDomain E E (idConverter J X Y) := by intro R hR hresp hE rw [trim_apply_id hR hresp] @@ -299,7 +299,7 @@ theorem idConverter_mapsDomain (E : List (Σ j, X j) → Prop) : /-- Domain preservation composes because attachment itself satisfies the serial equation. The intermediate system is the actual canonical attachment. -/ -theorem MapsDomain.comp +lemma MapsDomain.comp {E : List (Σ j, X j) → Prop} {F : List (Σ m, Xm m) → Prop} {G : List (Σ o, U o) → Prop} {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} {α : InsideOutsideSystem M J Xm Ym X Y} @@ -315,7 +315,7 @@ theorem MapsDomain.comp /-- Domain preservation gives the exact next-query condition required by the cumulative connection constructor. -/ -theorem MapsDomain.admits {E : List (Σ j, X j) → Prop} +lemma MapsDomain.admits {E : List (Σ j, X j) → Prop} {F : List (Σ o, U o) → Prop} {α : InsideOutsideSystem O J U V X Y} (hα : MapsDomain E F α) {R : InterfaceSystem J X Y} (hR : IsDDS R) (hresp : RepliesAtQueriedInterface R) (hE : ∀ h, (R h).Dom ↔ E h) @@ -326,7 +326,7 @@ theorem MapsDomain.admits {E : List (Σ j, X j) → Prop} exact (hα R hR hresp hE).2 _ /-- The left component is read only at prefixes of its own retained history. -/ -theorem pair_eq_on_prefixes_left {A B C D : Type} {s t : System A B} (R : System C D) +lemma pair_eq_on_prefixes_left {A B C D : Type} {s t : System A B} (R : System C D) {H : List (Two A C)} (he : ∀ p, p <+: restrict none H → s p = t p) : ∀ G, G <+: H → pair s R G = pair t R G := by intro G hG @@ -340,7 +340,7 @@ theorem pair_eq_on_prefixes_left {A B C D : Type} {s t : System A B} (R : System /-- Domain preservation depends only on finite converter behavior. This is the closure principle used when lifting to fresh converters. -/ -theorem IsResponsiveDDC.mapsDomain_of_replies {E : List (Σ j, X j) → Prop} +lemma IsResponsiveDDC.mapsDomain_of_replies {E : List (Σ j, X j) → Prop} {F : List (Σ o, U o) → Prop} {b : ℕ} {α : InsideOutsideSystem O J U V X Y} (hα : IsResponsiveDDC b α) (ha : ∀ xs ys, Replies α xs ys → ∃ (c : ℕ) (β : InsideOutsideSystem O J U V X Y), diff --git a/src/RandomSystems/Converter/ResourceCanon.lean b/src/RandomSystems/Converter/ResourceCanon.lean index 7b7fc2e..956216f 100644 --- a/src/RandomSystems/Converter/ResourceCanon.lean +++ b/src/RandomSystems/Converter/ResourceCanon.lean @@ -23,7 +23,7 @@ variable {O J : Type} {U V : O → Type} {X Y : J → Type} {α c : InsideOutsideSystem O J U V X Y} {R : InterfaceSystem J X Y} {b : ℕ} /-- A successful call returns at its outside label and leaves the converter idle. -/ -theorem resource_call_reply (hα : IsDDC b α) (hR : RepliesAtQueriedInterface R) +lemma resource_call_reply (hα : IsDDC b α) (hR : RepliesAtQueriedInterface R) {G o' G'} (l : Exchange (pair α R) resourceRoute G o' G') : ∀ o, AlongCall (ι := id) α o G → ∀ w, o' = some w → w.1 = o ∧ AlongIdle (ι := id) α G' := by @@ -77,7 +77,7 @@ theorem resource_call_reply (hα : IsDDC b α) (hR : RepliesAtQueriedInterface R /-- Canonicalization preserves a call, including a rejected resource query or a converter that stops. -/ -theorem resource_call_canon (hR : RepliesAtQueriedInterface R) +lemma resource_call_canon (hR : RepliesAtQueriedInterface R) {G o' G'} (l : Exchange (pair (canon c) R) resourceRoute G o' G') : ∀ o, AlongCall (ι := id) (canon c) o G → Exchange (pair c R) resourceRoute G o' G' := by @@ -129,7 +129,7 @@ theorem resource_call_canon (hR : RepliesAtQueriedInterface R) simpa only [outerOf, Option.none_or] using hlo /-- Every completed raw interaction also uses only legitimate converter histories. -/ -theorem replies_apply_canon (hc : IsDDC b (canon c)) (hR : RepliesAtQueriedInterface R) +lemma replies_apply_canon (hc : IsDDC b (canon c)) (hR : RepliesAtQueriedInterface R) (xs : List (Σ o, U o)) (ys : List (Σ o, V o)) : Replies (apply (canon c) R) xs ys ↔ Replies (apply c R) xs ys := by let F := interconnect (pair (canon c) R) resourceRoute resourceInput @@ -182,7 +182,7 @@ theorem replies_apply_canon (hc : IsDDC b (canon c)) (hR : RepliesAtQueriedInter exact h /-- Canonicalization does not change the partial DDS produced by attachment. -/ -theorem trim_apply_canon (hc : IsDDC b (canon c)) (hR : RepliesAtQueriedInterface R) : +lemma trim_apply_canon (hc : IsDDC b (canon c)) (hR : RepliesAtQueriedInterface R) : trim (apply (canon c) R) = trim (apply c R) := by apply IsDDS.eq_of_replies_iff (SilentAtEmpty.isDDS_trim (by simp [SilentAtEmpty, apply_eq])) diff --git a/src/RandomSystems/Cumulative/ConnectionObservation.lean b/src/RandomSystems/Cumulative/ConnectionObservation.lean index 2a5f725..71da821 100644 --- a/src/RandomSystems/Cumulative/ConnectionObservation.lean +++ b/src/RandomSystems/Cumulative/ConnectionObservation.lean @@ -33,7 +33,7 @@ variable {A B X Y : Type} def exposedReplies (route : Y → B ⊕ X) (ys : List Y) : List B := ys.filterMap fun y => (route y).getLeft? -theorem exposedReplies_append (route : Y → B ⊕ X) (ys zs : List Y) : +lemma exposedReplies_append (route : Y → B ⊕ X) (ys zs : List Y) : exposedReplies route (ys ++ zs) = exposedReplies route ys ++ exposedReplies route zs := by simp only [exposedReplies, List.filterMap_append] @@ -45,10 +45,10 @@ def connectionQueries (route : Y → B ⊕ X) (inj : A → X) (us : List A) : Li | none => inj us[(exposedReplies route ys).length] | some y => (route y).elim (fun _ => inj us[(exposedReplies route ys).length]) id⟩ -theorem connectionQueries_dom (route : Y → B ⊕ X) (inj : A → X) (us : List A) (ys : List Y) : +lemma connectionQueries_dom (route : Y → B ⊕ X) (inj : A → X) (us : List A) (ys : List Y) : (connectionQueries route inj us ys).Dom ↔ (exposedReplies route ys).length < us.length := Iff.rfl -theorem connectionQueries_prefix (route : Y → B ⊕ X) (inj : A → X) (us : List A) +lemma connectionQueries_prefix (route : Y → B ⊕ X) (inj : A → X) (us : List A) (ys : List Y) (y : Y) (hd : (connectionQueries route inj us (ys ++ [y])).Dom) : (connectionQueries route inj us ys).Dom := by change (exposedReplies route ys).length < us.length @@ -56,21 +56,21 @@ theorem connectionQueries_prefix (route : Y → B ⊕ X) (inj : A → X) (us : L simp only [exposedReplies, List.filterMap_append, List.length_append] at hd ⊢ omega -theorem connectionQueries_nil (route : Y → B ⊕ X) (inj : A → X) (us : List A) : +lemma connectionQueries_nil (route : Y → B ⊕ X) (inj : A → X) (us : List A) : connectionQueries route inj us [] = (us.head?.map inj : Part X) := by cases us with | nil => exact Part.ext fun _ => by simp [connectionQueries, exposedReplies] | cons a us => exact Part.ext fun _ => by simp [connectionQueries, exposedReplies, eq_comm] -theorem exposedReplies_snoc_in (route : Y → B ⊕ X) (ys : List Y) {y : Y} {x : X} +lemma exposedReplies_snoc_in (route : Y → B ⊕ X) (ys : List Y) {y : Y} {x : X} (hy : route y = .inr x) : exposedReplies route (ys ++ [y]) = exposedReplies route ys := by simp [exposedReplies, List.filterMap_append, hy] -theorem exposedReplies_snoc_out (route : Y → B ⊕ X) (ys : List Y) {y : Y} {b : B} +lemma exposedReplies_snoc_out (route : Y → B ⊕ X) (ys : List Y) {y : Y} {b : B} (hy : route y = .inl b) : exposedReplies route (ys ++ [y]) = exposedReplies route ys ++ [b] := by simp [exposedReplies, List.filterMap_append, hy] -theorem connectionQueries_snoc_in (route : Y → B ⊕ X) (inj : A → X) (us : List A) +lemma connectionQueries_snoc_in (route : Y → B ⊕ X) (inj : A → X) (us : List A) (ys : List Y) {y : Y} {x : X} (hy : route y = .inr x) (hd : (connectionQueries route inj us ys).Dom) : connectionQueries route inj us (ys ++ [y]) = Part.some x := by @@ -80,7 +80,7 @@ theorem connectionQueries_snoc_in (route : Y → B ⊕ X) (inj : A → X) (us : exact hd · simp [connectionQueries, List.getLast?_append, hy] -theorem connectionQueries_snoc_out (route : Y → B ⊕ X) (inj : A → X) (us : List A) +lemma connectionQueries_snoc_out (route : Y → B ⊕ X) (inj : A → X) (us : List A) (ys : List Y) {y : Y} {b : B} (hy : route y = .inl b) : connectionQueries route inj us (ys ++ [y]) = ((us[(exposedReplies route ys).length + 1]?).map inj : Part X) := by @@ -93,7 +93,7 @@ theorem connectionQueries_snoc_out (route : Y → B ⊕ X) (inj : A → X) (us : hy, hl] /-- A routing environment never receives more exposed replies than requested. -/ -theorem Cons.exposedReplies_length_le {route : Y → B ⊕ X} {inj : A → X} +lemma Cons.exposedReplies_length_le {route : Y → B ⊕ X} {inj : A → X} {us : List A} {h : List (X × Y)} (hc : Cons (connectionQueries route inj us) h) : (exposedReplies route (h.map Prod.snd)).length ≤ us.length := by rcases List.eq_nil_or_concat h with rfl | ⟨h, z, rfl⟩ @@ -108,7 +108,7 @@ theorem Cons.exposedReplies_length_le {route : Y → B ⊕ X} {inj : A → X} /-- Observing one existing internal exchange extends the source transcript and adds exactly its exposed reply. This applies to partial systems as well. -/ -theorem exchange_transcript_connection {s : System X Y} {route : Y → B ⊕ X} +lemma exchange_transcript_connection {s : System X Y} {route : Y → B ⊕ X} (inj : A → X) (us : List A) {G o G'} (l : Exchange s route G o G') : ∀ H x ys b, G = H ++ [x] → o = some b → Transcript s (connectionQueries route inj us) H ys → @@ -137,7 +137,7 @@ theorem exchange_transcript_connection {s : System X Y} {route : Y → B ⊕ X} /-- The exposed prefixes of a routed transcript are replies of the existing connection. The second clause extends the same internal history through the pending exchange; no incompatible histories are combined. -/ -theorem transcript_connection {s : System X Y} {route : Y → B ⊕ X} +lemma transcript_connection {s : System X Y} {route : Y → B ⊕ X} {inj : A → X} {us : List A} {xs : List X} {ys : List Y} (tr : Transcript s (connectionQueries route inj us) xs ys) : Replies (interconnect s route inj) (us.take (exposedReplies route ys).length) @@ -188,7 +188,7 @@ theorem transcript_connection {s : System X Y} {route : Y → B ⊕ X} subst x' exact ih.2 x hx o H (Exchange.feed _ y z o H hy he l) -theorem replies_of_completed_connection {s : System X Y} {route : Y → B ⊕ X} +lemma replies_of_completed_connection {s : System X Y} {route : Y → B ⊕ X} {inj : A → X} {us : List A} {xs : List X} {ys : List Y} (tr : Transcript s (connectionQueries route inj us) xs ys) (hd : ¬ (connectionQueries route inj us ys).Dom) : @@ -199,7 +199,7 @@ theorem replies_of_completed_connection {s : System X Y} {route : Y → B ⊕ X} /-- Every completed connection prefix can be observed using the same source history. The next external query is the next element of the supplied sequence. -/ -theorem transcript_of_connection_replies {s : System X Y} {route : Y → B ⊕ X} +lemma transcript_of_connection_replies {s : System X Y} {route : Y → B ⊕ X} {inj : A → X} {us u : List A} {v : List B} (hr : Replies (interconnect s route inj) u v) (hu : u <+: us) : ∃ H ys, Induces s route inj u v.getLast? H ∧ @@ -238,7 +238,7 @@ theorem transcript_of_connection_replies {s : System X Y} {route : Y → B ⊕ X /-- Completed transcripts characterize the replies of general system connection, before any probabilistic lifting. -/ -theorem replies_connection_iff {s : System X Y} {route : Y → B ⊕ X} +lemma replies_connection_iff {s : System X Y} {route : Y → B ⊕ X} {inj : A → X} (us : List A) (vs : List B) : Replies (interconnect s route inj) us vs ↔ ∃ xs ys, Transcript s (connectionQueries route inj us) xs ys ∧ @@ -253,7 +253,7 @@ theorem replies_connection_iff {s : System X Y} {route : Y → B ⊕ X} /-- A connection preserves inclusion of completed component behavior. Silent exchanges are irrelevant here: every observed prefix has a completed reply. -/ -theorem Replies.interconnect_mono {s t : System X Y} +lemma Replies.interconnect_mono {s t : System X Y} (hst : ∀ h y, y ∈ s h → y ∈ t h) {route : Y → B ⊕ X} {inj : A → X} {us vs} (hr : Replies (interconnect s route inj) us vs) : Replies (interconnect t route inj) us vs := by @@ -263,7 +263,7 @@ theorem Replies.interconnect_mono {s t : System X Y} /-- The bound on consecutive internal queries bounds the complete component transcript of each exposed history, even for partial components. -/ -theorem Transcript.connection_length_le +lemma Transcript.connection_length_le {Xa Ya Xb Yb : Type} {a : System Xa Ya} {b : System Xb Yb} {P : Ya → Prop} {route : Two Ya Yb → B ⊕ Two Xa Xb} {inj : A → Two Xa Xb} {n : ℕ} (hc : CyclesThrough P route) (hb : ∀ h, (a h).Dom → run P a h ≤ n) @@ -293,14 +293,14 @@ noncomputable def connectionLaw (R : RandomSystem X Y D) (route : Y → B ⊕ X) ((R.sLaw (connectionQueries route inj us) n).restrict fun h => ¬ (connectionQueries route inj us (h.map Prod.snd)).Dom) -theorem connectionLaw_nonneg (R : RandomSystem X Y D) (route : Y → B ⊕ X) +lemma connectionLaw_nonneg (R : RandomSystem X Y D) (route : Y → B ⊕ X) (inj : A → X) (us : List A) (n : ℕ) : (R.connectionLaw route inj us n).NonNeg := ((sLaw_nonNeg n).restrict _).fTransform _ /-- Every completed internal transcript contributes its probability to its exposed reply sequence. -/ -theorem mass_le_connectionLaw (R : RandomSystem X Y D) (route : Y → B ⊕ X) +lemma mass_le_connectionLaw (R : RandomSystem X Y D) (route : Y → B ⊕ X) (inj : A → X) (us : List A) (n : ℕ) (h : List (X × Y)) (hc : Cons (connectionQueries route inj us) h) (hn : h.length ≤ n) (hd : ¬ (connectionQueries route inj us (h.map Prod.snd)).Dom) : @@ -316,7 +316,7 @@ theorem mass_le_connectionLaw (R : RandomSystem X Y D) (route : Y → B ⊕ X) /-- Connection preserves a finite probabilistic choice among behaviors on the same admitted domain. -/ -theorem connectionLaw_mix {ι : Type} (P : Distribution.ProbDist ι) +lemma connectionLaw_mix {ι : Type} (P : Distribution.ProbDist ι) (R : ι → RandomSystem X Y D) (route : Y → B ⊕ X) (inj : A → X) (us : List A) (n : ℕ) : (mix P R).connectionLaw route inj us n = @@ -337,7 +337,7 @@ theorem connectionLaw_mix {ι : Type} (P : Distribution.ProbDist ι) simp only [Distribution.fTransform_smul] /-- Every completed outcome contains exactly one reply to each exposed input. -/ -theorem connectionLaw_length (R : RandomSystem X Y D) (route : Y → B ⊕ X) +lemma connectionLaw_length (R : RandomSystem X Y D) (route : Y → B ⊕ X) (inj : A → X) (us : List A) (n : ℕ) {vs : List B} (hv : vs ∈ (R.connectionLaw route inj us n).support) : vs.length = us.length := by obtain ⟨h, hh, rfl⟩ := Distribution.mem_support_fTransform _ _ hv @@ -348,7 +348,7 @@ theorem connectionLaw_length (R : RandomSystem X Y D) (route : Y → B ⊕ X) /-- Compatible, completed observations yield probability distributions. Both hypotheses are explicit for partial resources. -/ -theorem connectionLaw_isProbDist (R : RandomSystem X Y D) (route : Y → B ⊕ X) +lemma connectionLaw_isProbDist (R : RandomSystem X Y D) (route : Y → B ⊕ X) (inj : A → X) (us : List A) (n : ℕ) (hc : Compatible R (connectionQueries route inj us)) (hs : ∀ h, Cons (connectionQueries route inj us) h → R h ≠ 0 → h.length = n → @@ -374,7 +374,7 @@ theorem connectionLaw_isProbDist (R : RandomSystem X Y D) (route : Y → B ⊕ X exact Distribution.fTransform_isProbDist _ (sLaw_isProbDist hc n) /-- A sufficient internal bound is immaterial to the completed reply law. -/ -theorem connectionLaw_stable (R : RandomSystem X Y D) (route : Y → B ⊕ X) +lemma connectionLaw_stable (R : RandomSystem X Y D) (route : Y → B ⊕ X) (inj : A → X) (us : List A) {n m : ℕ} (hn : n ≤ m) (hb : ∀ h, Cons (connectionQueries route inj us) h → R h ≠ 0 → ¬ (connectionQueries route inj us (h.map Prod.snd)).Dom → h.length ≤ n) : @@ -383,7 +383,7 @@ theorem connectionLaw_stable (R : RandomSystem X Y D) (route : Y → B ⊕ X) rw [sLaw_completed_stable R _ hn hb] /-- Any two sufficient bounds give the same completed law. -/ -theorem connectionLaw_eq_of_bounds (R : RandomSystem X Y D) (route : Y → B ⊕ X) +lemma connectionLaw_eq_of_bounds (R : RandomSystem X Y D) (route : Y → B ⊕ X) (inj : A → X) (us : List A) (n m : ℕ) (hn : ∀ h, Cons (connectionQueries route inj us) h → R h ≠ 0 → ¬ (connectionQueries route inj us (h.map Prod.snd)).Dom → h.length ≤ n) @@ -397,7 +397,7 @@ theorem connectionLaw_eq_of_bounds (R : RandomSystem X Y D) (route : Y → B ⊕ /-- On a finite presentation, completed connection probabilities agree with the existing deterministic connection. The bound concerns the completed internal transcripts, not the number of samples in the presentation. -/ -theorem connectionLaw_eq_mass {ι : Type} (R : RandomSystem X Y D) +lemma connectionLaw_eq_mass {ι : Type} (R : RandomSystem X Y D) (P : Distribution ι) (hP : P.NonNeg) (systems : ι → System X Y) (hR : ∀ h, R h = P.mass (fun s => Replies (systems s) (h.map Prod.fst) (h.map Prod.snd))) (route : Y → B ⊕ X) (inj : A → X) (us : List A) (n : ℕ) @@ -432,7 +432,7 @@ theorem connectionLaw_eq_mass {ι : Type} (R : RandomSystem X Y D) /-- The connection of two independent random systems is observed through one pair of independent finite presentations, whose samples have every property of the realizations of possible choices. -/ -theorem exists_parallel_connection_presentations +lemma exists_parallel_connection_presentations {X' Y' : Type} [Fintype X'] [Fintype Y'] {D' : Domain X' Y'} (R : RandomSystem X Y D) (S : RandomSystem X' Y' D') (route : Two Y Y' → B ⊕ Two X X') (inj : A → Two X X') (bound : List A → ℕ) @@ -461,7 +461,7 @@ theorem exists_parallel_connection_presentations /-- Deterministic component bounds bound every possible transcript of the parallel system. -/ -theorem parallel_connection_length_le +lemma parallel_connection_length_le {X' Y' : Type} [Fintype X'] [Fintype Y'] {D' : Domain X' Y'} (R : RandomSystem X Y D) (S : RandomSystem X' Y' D') (route : Two Y Y' → B ⊕ Two X X') (inj : A → Two X X') diff --git a/src/RandomSystems/Cumulative/Cumulative.lean b/src/RandomSystems/Cumulative/Cumulative.lean index 0b9e86d..c9c7cac 100644 --- a/src/RandomSystems/Cumulative/Cumulative.lean +++ b/src/RandomSystems/Cumulative/Cumulative.lean @@ -59,11 +59,11 @@ variable [Fintype A] [Fintype B] {D : Domain A B} instance : CoeFun (RandomSystem A B D) (fun _ => List (A × B) → ℝ) := ⟨Subtype.val⟩ -@[ext] theorem ext {R S : RandomSystem A B D} (h : ∀ t, R t = S t) : R = S := +@[ext] lemma ext {R S : RandomSystem A B D} (h : ∀ t, R t = S t) : R = S := Subtype.ext (funext h) -theorem mass_nil (R : RandomSystem A B D) : R [] = 1 := R.2.1 -theorem mass_nonneg (R : RandomSystem A B D) (h : List (A × B)) : 0 ≤ R h := R.2.2.1 h +lemma mass_nil (R : RandomSystem A B D) : R [] = 1 := R.2.1 +lemma mass_nonneg (R : RandomSystem A B D) (h : List (A × B)) : 0 ≤ R h := R.2.2.1 h /-- Responding interface systems return their reply at the queried interface. The alphabets may differ at every interface and the domain may be partial. -/ @@ -76,20 +76,20 @@ def RepliesAtQueriedInterface {I : Type} {X Y : I → Type} noncomputable def extensionLaw (R : RandomSystem A B D) (h : List (A × B)) (x : A) : Distribution B := Classical.choose (R.2.2.2 h x) -theorem extensionLaw_apply (R : RandomSystem A B D) (h : List (A × B)) (x : A) (y : B) : +lemma extensionLaw_apply (R : RandomSystem A B D) (h : List (A × B)) (x : A) (y : B) : R.extensionLaw h x y = R (h ++ [(x, y)]) := (Classical.choose_spec (R.2.2.2 h x)).1 y -theorem extensionLaw_weight (R : RandomSystem A B D) (h : List (A × B)) (x : A) : +lemma extensionLaw_weight (R : RandomSystem A B D) (h : List (A × B)) (x : A) : (R.extensionLaw h x).weight = if D h x then R h else 0 := (Classical.choose_spec (R.2.2.2 h x)).2 -theorem extensionLaw_nonneg (R : RandomSystem A B D) (h : List (A × B)) (x : A) : +lemma extensionLaw_nonneg (R : RandomSystem A B D) (h : List (A × B)) (x : A) : (R.extensionLaw h x).NonNeg := by intro y rw [extensionLaw_apply] exact R.mass_nonneg _ -theorem mass_snoc_le (R : RandomSystem A B D) (h : List (A × B)) (x : A) (y : B) : +lemma mass_snoc_le (R : RandomSystem A B D) (h : List (A × B)) (x : A) (y : B) : R (h ++ [(x, y)]) ≤ R h := by rw [← extensionLaw_apply] calc R.extensionLaw h x y ≤ (R.extensionLaw h x).mass (· = y) := @@ -97,7 +97,7 @@ theorem mass_snoc_le (R : RandomSystem A B D) (h : List (A × B)) (x : A) (y : B _ ≤ (R.extensionLaw h x).weight := Distribution.mass_le_weight (R.extensionLaw_nonneg h x) _ _ ≤ R h := by rw [extensionLaw_weight]; split_ifs <;> simp [R.mass_nonneg] -theorem mass_append_le (R : RandomSystem A B D) (h e : List (A × B)) : +lemma mass_append_le (R : RandomSystem A B D) (h e : List (A × B)) : R (h ++ e) ≤ R h := by induction e using List.reverseRecOn with | nil => simp @@ -105,13 +105,13 @@ theorem mass_append_le (R : RandomSystem A B D) (h e : List (A × B)) : rw [← List.append_assoc] exact (R.mass_snoc_le _ z.1 z.2).trans ih -theorem mass_eq_zero_of_prefix (R : RandomSystem A B D) {h h' : List (A × B)} +lemma mass_eq_zero_of_prefix (R : RandomSystem A B D) {h h' : List (A × B)} (hp : h <+: h') (h0 : R h = 0) : R h' = 0 := by obtain ⟨e, rfl⟩ := hp exact le_antisymm (h0 ▸ R.mass_append_le h e) (R.mass_nonneg _) /-- Every positive admitted history has at least one possible reply. -/ -theorem exists_reply (R : RandomSystem A B D) {h : List (A × B)} {x : A} +lemma exists_reply (R : RandomSystem A B D) {h : List (A × B)} {x : A} (hd : D h x) (hp : R h ≠ 0) : ∃ y, R (h ++ [(x, y)]) ≠ 0 := by by_contra hn have hz : R.extensionLaw h x = 0 := by @@ -139,12 +139,12 @@ noncomputable def relabel {A' B' : Type} [Fintype A'] [Fintype B'] (R : RandomSy · rw [Distribution.weight_fTransform, extensionLaw_weight] rfl⟩ -theorem relabel_mass {A' B' : Type} [Fintype A'] [Fintype B'] (R : RandomSystem A B D) +lemma relabel_mass {A' B' : Type} [Fintype A'] [Fintype B'] (R : RandomSystem A B D) (inputs : A ≃ A') (outputs : B ≃ B') (h : List (A' × B')) : R.relabel inputs outputs h = R (h.map (inputs.symm.prodCongr outputs.symm)) := rfl /-- Relabeling does not identify distinct probabilistic behaviors. -/ -theorem relabel_injective {A' B' : Type} [Fintype A'] [Fintype B'] (inputs : A ≃ A') +lemma relabel_injective {A' B' : Type} [Fintype A'] [Fintype B'] (inputs : A ≃ A') (outputs : B ≃ B') : Function.Injective (fun R : RandomSystem A B D => R.relabel inputs outputs) := by intro R S he @@ -158,7 +158,7 @@ theorem relabel_injective {A' B' : Type} [Fintype A'] [Fintype B'] (inputs : A simpa only [relabel_mass, List.map_map, hid, List.map_id] using hh /-- An inadmissible query has no reply mass at any output. -/ -theorem mass_eq_zero_of_not_admitted (R : RandomSystem A B D) {h : List (A × B)} {x : A} +lemma mass_eq_zero_of_not_admitted (R : RandomSystem A B D) {h : List (A × B)} {x : A} (hd : ¬ D h x) (y : B) : R (h ++ [(x, y)]) = 0 := by apply le_antisymm _ (R.mass_nonneg _) rw [← extensionLaw_apply] @@ -168,7 +168,7 @@ theorem mass_eq_zero_of_not_admitted (R : RandomSystem A B D) {h : List (A × B) _ = 0 := by rw [extensionLaw_weight, if_neg hd] /-- A random system has no mass on transcripts longer than its domain's bound. -/ -theorem mass_eq_zero_of_bound_lt (R : RandomSystem A B D) {h : List (A × B)} +lemma mass_eq_zero_of_bound_lt (R : RandomSystem A B D) {h : List (A × B)} (hl : D.bound < h.length) : R h = 0 := by have hi : D.bound < h.length := hl have ht : h.take (D.bound + 1) = h.take D.bound ++ [((h[D.bound]).1, (h[D.bound]).2)] := by @@ -181,7 +181,7 @@ theorem mass_eq_zero_of_bound_lt (R : RandomSystem A B D) {h : List (A × B)} (ht ▸ R.mass_eq_zero_of_not_admitted hn _) /-- Every query in a possible transcript is admitted at a possible prefix. -/ -theorem possible_prefix (R : RandomSystem A B D) {h : List (A × B)} (hh : R h ≠ 0) +lemma possible_prefix (R : RandomSystem A B D) {h : List (A × B)} (hh : R h ≠ 0) (i : ℕ) (hi : i < h.length) : D (h.take i) (h[i]).1 ∧ R (h.take i) ≠ 0 := by refine ⟨?_, fun hz => hh (R.mass_eq_zero_of_prefix (List.take_prefix i h) hz)⟩ by_contra hn @@ -192,7 +192,7 @@ theorem possible_prefix (R : RandomSystem A B D) {h : List (A × B)} (hh : R h omit [Fintype A] [Fintype B] in /-- A finite mixture of systems with domain `D` has a cumulative behavior normalized on `D`. -/ -theorem _root_.SystemAlgebra.isRandomSystem_behaviorMass {D : List (A × B) → A → Prop} +lemma _root_.SystemAlgebra.isRandomSystem_behaviorMass {D : List (A × B) → A → Prop} {p : System A B → Prop} (P : Distribution {s : System A B // p s}) (hP : P.isProbDist) (hD : ∀ s ∈ P.support, ∀ h x, Replies s.1 (h.map Prod.fst) (h.map Prod.snd) → ((s.1 (h.map Prod.fst ++ [x])).Dom ↔ D h x)) : @@ -217,12 +217,12 @@ noncomputable def _root_.SystemAlgebra.PDS.behavior (P : PDS A B D) (hP : P.isPr RandomSystem A B D := ofPDS P hP (fun s _ h x hr => s.2.2 h x hr) -theorem _root_.SystemAlgebra.PDS.behavior_mass (P : PDS A B D) (hP : P.isProbDist) +lemma _root_.SystemAlgebra.PDS.behavior_mass (P : PDS A B D) (hP : P.isProbDist) (h : List (A × B)) : PDS.behavior P hP h = behaviorMass P (h.map Prod.fst) (h.map Prod.snd) := rfl /-- The behavior map identifies exactly equal cumulative behaviors of PDSs. -/ -theorem _root_.SystemAlgebra.PDS.behavior_eq_iff {P Q : PDS A B D} (hP : P.isProbDist) +lemma _root_.SystemAlgebra.PDS.behavior_eq_iff {P Q : PDS A B D} (hP : P.isProbDist) (hQ : Q.isProbDist) : PDS.behavior P hP = PDS.behavior Q hQ ↔ Equivalent P Q := by constructor · intro he xs ys @@ -249,10 +249,10 @@ noncomputable def ofPDSClass : Quotient (pdsSetoid D) → RandomSystem A B D := Quotient.lift (fun P => PDS.behavior P.1 P.2) (fun P Q h => (PDS.behavior_eq_iff P.2 Q.2).mpr h) -@[simp] theorem ofPDSClass_mk (P : Distribution.ProbDist {s : System A B // IsDDS s ∧ HasDomain D s}) : +@[simp] lemma ofPDSClass_mk (P : Distribution.ProbDist {s : System A B // IsDDS s ∧ HasDomain D s}) : ofPDSClass D (Quotient.mk (pdsSetoid D) P) = PDS.behavior P.1 P.2 := rfl -theorem ofPDSClass_injective : Function.Injective (ofPDSClass D) := by +lemma ofPDSClass_injective : Function.Injective (ofPDSClass D) := by intro P Q induction P using Quotient.inductionOn with | _ P => @@ -272,10 +272,10 @@ noncomputable def conditional (R : RandomSystem A B D) (h : List (A × B)) (x : exact div_nonneg (R.extensionLaw_nonneg h x y) (R.mass_nonneg h) · rw [Distribution.weight_mapRange_div, extensionLaw_weight, if_pos hd.1, div_self hd.2]⟩⟩ -@[simp] theorem conditional_dom (R : RandomSystem A B D) (h : List (A × B)) (x : A) : +@[simp] lemma conditional_dom (R : RandomSystem A B D) (h : List (A × B)) (x : A) : (R.conditional h x).Dom ↔ D h x ∧ R h ≠ 0 := Iff.rfl -theorem conditional_apply (R : RandomSystem A B D) (h : List (A × B)) (x : A) +lemma conditional_apply (R : RandomSystem A B D) (h : List (A × B)) (x : A) (hd : (R.conditional h x).Dom) (y : B) : (R.conditional h x).get hd y = R (h ++ [(x, y)]) / R h := by change R.extensionLaw h x y / R h = _ @@ -290,18 +290,18 @@ noncomputable def conditionalMass (t : List (A × B)) : ℝ := List.reverseRecOn t 1 fun h z p => if hd : D h z.1 then p * q h z.1 hd z.2 else 0 omit [Fintype A] [Fintype B] in -@[simp] theorem conditionalMass_nil : conditionalMass q [] = 1 := by +@[simp] lemma conditionalMass_nil : conditionalMass q [] = 1 := by simp [conditionalMass] omit [Fintype A] [Fintype B] in -theorem conditionalMass_snoc (h : List (A × B)) (x : A) (y : B) : +lemma conditionalMass_snoc (h : List (A × B)) (x : A) (y : B) : conditionalMass q (h ++ [(x, y)]) = if hd : D h x then conditionalMass q h * q h x hd y else 0 := by unfold conditionalMass rw [List.reverseRecOn_concat] omit [Fintype A] [Fintype B] in -theorem conditionalMass_nonneg (h : List (A × B)) : 0 ≤ conditionalMass q h := by +lemma conditionalMass_nonneg (h : List (A × B)) : 0 ≤ conditionalMass q h := by induction h using List.reverseRecOn with | nil => rw [conditionalMass_nil]; exact zero_le_one | append_singleton h z ih => @@ -328,7 +328,7 @@ noncomputable def ofConditional : RandomSystem A B D := rw [weighted, (q h x hd).2.2, mul_one] · exact ⟨0, fun y => by simp [conditionalMass_snoc, hd], by simp [hd, Distribution.weight]⟩⟩ -theorem ofConditional_snoc (h : List (A × B)) (x : A) (y : B) : +lemma ofConditional_snoc (h : List (A × B)) (x : A) (y : B) : ofConditional q (h ++ [(x, y)]) = if hd : D h x then ofConditional q h * q h x hd y else 0 := conditionalMass_snoc q h x y diff --git a/src/RandomSystems/Cumulative/CumulativeAttachment.lean b/src/RandomSystems/Cumulative/CumulativeAttachment.lean index f51c30b..77ec98a 100644 --- a/src/RandomSystems/Cumulative/CumulativeAttachment.lean +++ b/src/RandomSystems/Cumulative/CumulativeAttachment.lean @@ -40,7 +40,7 @@ include hp hq hb hE /-- Independent finite presentations of the components present the connection; its samples answer exactly on the specified domain. -/ -theorem connection_isRandomSystem : IsRandomSystem E (fun h => +lemma connection_isRandomSystem : IsRandomSystem E (fun h => (parallel R S).connectionLaw route inj (h.map Prod.fst) (bound (h.map Prod.fst)) (h.map Prod.snd)) := by obtain ⟨P, Q, he⟩ := exists_parallel_connection_presentations R S route inj bound p q hp hq hb @@ -71,14 +71,14 @@ noncomputable def connection : RandomSystem A B E := (bound (h.map Prod.fst)) (h.map Prod.snd), connection_isRandomSystem R S route inj bound hp hq hb hE⟩ -theorem connection_mass (h : List (A × B)) : +lemma connection_mass (h : List (A × B)) : connection R S route inj bound hp hq hb hE h = (parallel R S).connectionLaw route inj (h.map Prod.fst) (bound (h.map Prod.fst)) (h.map Prod.snd) := rfl /-- Every possible finite attached history is witnessed by deterministic components in the same classes. -/ -theorem connection_replies {h : List (A × B)} +lemma connection_replies {h : List (A × B)} (hh : connection R S route inj bound hp hq hb hE h ≠ 0) : ∃ a b, p a ∧ q b ∧ Replies (interconnect (pair a b) route inj) (h.map Prod.fst) (h.map Prod.snd) := by diff --git a/src/RandomSystems/Cumulative/CumulativeObservation.lean b/src/RandomSystems/Cumulative/CumulativeObservation.lean index 7c1dd7e..5282729 100644 --- a/src/RandomSystems/Cumulative/CumulativeObservation.lean +++ b/src/RandomSystems/Cumulative/CumulativeObservation.lean @@ -53,9 +53,9 @@ def Good (n : ℕ) (h : List (A × B)) : Prop := Cons σ h ∧ Done σ n h variable {σ} -theorem cons_nil : Cons σ ([] : List (A × B)) := fun i hi => absurd hi (by simp) +lemma cons_nil : Cons σ ([] : List (A × B)) := fun i hi => absurd hi (by simp) -theorem cons_snoc {h : List (A × B)} {z : A × B} : +lemma cons_snoc {h : List (A × B)} {z : A × B} : Cons σ (h ++ [z]) ↔ Cons σ h ∧ z.1 ∈ σ (h.map Prod.snd) := by constructor · intro hc @@ -75,7 +75,7 @@ theorem cons_snoc {h : List (A × B)} {z : A × B} : rw [List.take_left' rfl] simpa using hz -theorem Cons.of_prefix {h h' : List (A × B)} (hc : Cons σ h') (hp : h <+: h') : Cons σ h := by +lemma Cons.of_prefix {h h' : List (A × B)} (hc : Cons σ h') (hp : h <+: h') : Cons σ h := by obtain ⟨e, rfl⟩ := hp intro i hi have := hc i (by simp; omega) @@ -83,7 +83,7 @@ theorem Cons.of_prefix {h h' : List (A × B)} (hc : Cons σ h') (hp : h <+: h') variable {s : System A B} -theorem transcript_cons {s : System A B} {xs ys} +lemma transcript_cons {s : System A B} {xs ys} (tr : Transcript s σ xs ys) : Cons σ (xs.zip ys) := by induction tr with | nil => exact cons_nil @@ -93,7 +93,7 @@ theorem transcript_cons {s : System A B} {xs ys} rw [List.map_snd_zip (by rw [tr.length_eq])] exact hx -theorem transcript_of_cons {s : System A B} : +lemma transcript_of_cons {s : System A B} : ∀ {h : List (A × B)}, Cons σ h → Replies s (h.map Prod.fst) (h.map Prod.snd) → Transcript s σ (h.map Prod.fst) (h.map Prod.snd) := by intro h @@ -122,7 +122,7 @@ noncomputable def tSupp : ℕ → Finset (List (A × B)) variable {R σ} -theorem tSupp_good : ∀ {m h}, h ∈ tSupp R σ m → Good σ m h := by +lemma tSupp_good : ∀ {m h}, h ∈ tSupp R σ m → Good σ m h := by intro m induction m with | zero => intro h hh; simp [tSupp] at hh; subst hh; exact ⟨cons_nil, Or.inl rfl⟩ @@ -143,7 +143,7 @@ theorem tSupp_good : ∀ {m h}, h ∈ tSupp R σ m → Good σ m h := by refine ⟨hc, Or.inr ⟨?_, hd⟩⟩ rcases hd' with h | ⟨h, _⟩ <;> omega -theorem mem_tSupp : ∀ {m h}, Good σ m h → R h ≠ 0 → h ∈ tSupp R σ m := by +lemma mem_tSupp : ∀ {m h}, Good σ m h → R h ≠ 0 → h ∈ tSupp R σ m := by intro m induction m with | zero => @@ -184,10 +184,10 @@ noncomputable def sLaw (n : ℕ) : Distribution (List (A × B)) := variable {R σ} -theorem sLaw_apply (n : ℕ) (h : List (A × B)) : +lemma sLaw_apply (n : ℕ) (h : List (A × B)) : sLaw R σ n h = if Good σ n h then R h else 0 := Finsupp.onFinset_apply -theorem sLaw_nonNeg (n : ℕ) : (sLaw R σ n).NonNeg := fun h => by +lemma sLaw_nonNeg (n : ℕ) : (sLaw R σ n).NonNeg := fun h => by rw [sLaw_apply]; split_ifs · exact R.mass_nonneg _ · exact le_rfl @@ -197,7 +197,7 @@ is admitted. It neither totalizes the resource nor requires a decision output. - def Compatible (R : RandomSystem A B D) (σ : List B →. A) : Prop := ∀ h x, Cons σ h → R h ≠ 0 → x ∈ σ (h.map Prod.snd) → D h x -theorem sum_extension (R : RandomSystem A B D) (h : List (A × B)) (x : A) +lemma sum_extension (R : RandomSystem A B D) (h : List (A × B)) (x : A) (hd : D h x) : ∑ y ∈ (R.extensionLaw h x).support, R (h ++ [(x, y)]) = R h := by have hw := R.extensionLaw_weight h x rw [if_pos hd] at hw @@ -205,7 +205,7 @@ theorem sum_extension (R : RandomSystem A B D) (h : List (A × B)) (x : A) unfold Finsupp.sum exact Finset.sum_congr rfl fun y _ => (R.extensionLaw_apply h x y).symm -theorem tSupp_possible : ∀ {m h}, h ∈ tSupp R σ m → R h ≠ 0 := by +lemma tSupp_possible : ∀ {m h}, h ∈ tSupp R σ m → R h ≠ 0 := by intro m induction m with | zero => @@ -226,7 +226,7 @@ theorem tSupp_possible : ∀ {m h}, h ∈ tSupp R σ m → R h ≠ 0 := by /-- **One more round**: a sum over the transcripts of `σ` within `m + 1` rounds is the sum, over the transcripts within `m` rounds, of the sum over their extensions by the possible replies to the next query of `σ`, or of the transcript itself when `σ` has stopped. -/ -theorem sum_tSupp_succ (f : List (A × B) → ℝ) (m : ℕ) : +lemma sum_tSupp_succ (f : List (A × B) → ℝ) (m : ℕ) : ∑ h ∈ tSupp R σ (m + 1), f h = ∑ h ∈ tSupp R σ m, if hd : (σ (h.map Prod.snd)).Dom then ∑ y ∈ (R.extensionLaw h ((σ (h.map Prod.snd)).get hd)).support, @@ -273,7 +273,7 @@ theorem sum_tSupp_succ (f : List (A × B) → ℝ) (m : ℕ) : -- Both kept: both are the transcript g. · exact hne ((Finset.mem_singleton.mp hg).symm.trans (Finset.mem_singleton.mp hg')) -theorem sum_tSupp (hC : Compatible R σ) : +lemma sum_tSupp (hC : Compatible R σ) : ∀ m, ∑ h ∈ tSupp R σ m, (if Good σ m h then R h else 0) = 1 := by intro m induction m with @@ -300,7 +300,7 @@ theorem sum_tSupp (hC : Compatible R σ) : · rw [dif_neg hd, if_pos ⟨hc, Or.inr ⟨by rcases hd' with hl | ⟨hl, _⟩ <;> omega, hd⟩⟩] /-- **The transcript law is a probability distribution.** -/ -theorem sLaw_isProbDist (hC : Compatible R σ) (n : ℕ) : (sLaw R σ n).isProbDist := by +lemma sLaw_isProbDist (hC : Compatible R σ) (n : ℕ) : (sLaw R σ n).isProbDist := by refine ⟨sLaw_nonNeg n, ?_⟩ unfold Distribution.weight sLaw rw [Finsupp.onFinset_sum _ (fun _ => rfl)] @@ -308,7 +308,7 @@ theorem sLaw_isProbDist (hC : Compatible R σ) (n : ℕ) : (sLaw R σ n).isProbD /-- Any two bounds beyond all possible queries give the same completed transcript law. The bound is needed only on possible interaction histories. -/ -theorem sLaw_eq_of_query_bounds {n m : ℕ} +lemma sLaw_eq_of_query_bounds {n m : ℕ} (hn : ∀ h, Cons σ h → R h ≠ 0 → (σ (h.map Prod.snd)).Dom → h.length < n) (hm : ∀ h, Cons σ h → R h ≠ 0 → (σ (h.map Prod.snd)).Dom → h.length < m) : R.sLaw σ n = R.sLaw σ m := by @@ -342,7 +342,7 @@ theorem sLaw_eq_of_query_bounds {n m : ℕ} /-- Restricting to completed observations removes the artificial truncation at the observation bound. -/ -theorem sLaw_completed_apply (R : RandomSystem A B D) (σ : List B →. A) +lemma sLaw_completed_apply (R : RandomSystem A B D) (σ : List B →. A) (n : ℕ) (h : List (A × B)) : ((R.sLaw σ n).restrict fun h => ¬ (σ (h.map Prod.snd)).Dom) h = if Cons σ h ∧ h.length ≤ n ∧ ¬ (σ (h.map Prod.snd)).Dom then R h else 0 := by @@ -355,7 +355,7 @@ theorem sLaw_completed_apply (R : RandomSystem A B D) (σ : List B →. A) /-- Once all possible completed transcripts fit, increasing the observation bound changes no completed probability, even for partial resources. -/ -theorem sLaw_completed_stable (R : RandomSystem A B D) (σ : List B →. A) +lemma sLaw_completed_stable (R : RandomSystem A B D) (σ : List B →. A) {n m : ℕ} (hn : n ≤ m) (hb : ∀ h, Cons σ h → R h ≠ 0 → ¬ (σ (h.map Prod.snd)).Dom → h.length ≤ n) : (R.sLaw σ n).restrict (fun h => ¬ (σ (h.map Prod.snd)).Dom) = @@ -375,7 +375,7 @@ theorem sLaw_completed_stable (R : RandomSystem A B D) (σ : List B →. A) /-- For a finite presentation, the probability of a completed observation is the mass of precisely those samples that produce that observation. Partiality is retained: an unanswered query is not a completed transcript. -/ -theorem sLaw_completed_eq_mass {ι : Type} (R : RandomSystem A B D) +lemma sLaw_completed_eq_mass {ι : Type} (R : RandomSystem A B D) (P : Distribution ι) (hP : P.NonNeg) (systems : ι → System A B) (hR : ∀ h, R h = P.mass (fun s => Replies (systems s) (h.map Prod.fst) (h.map Prod.snd))) (σ : List B →. A) (n : ℕ) (E : List (A × B) → Prop) : @@ -451,7 +451,7 @@ end RandomSystem section Follow -theorem cons_fixedQueries {xs : List A} {t : List (A × B)} (hc : Cons (fixedQueries xs) t) : +lemma cons_fixedQueries {xs : List A} {t : List (A × B)} (hc : Cons (fixedQueries xs) t) : t.length ≤ xs.length ∧ t.map Prod.fst = xs.take t.length := by induction t using List.reverseRecOn with | nil => simp @@ -472,7 +472,7 @@ replies agree with `h`, and stops as soon as they deviate. -/ noncomputable def follow (h : List (A × B)) : List B →. A := fun ys => if ys = (h.take ys.length).map Prod.snd then fixedQueries (h.map Prod.fst) ys else Part.none -theorem mem_follow {h : List (A × B)} {ys : List B} {x : A} : +lemma mem_follow {h : List (A × B)} {ys : List B} {x : A} : x ∈ follow h ys ↔ ys = (h.take ys.length).map Prod.snd ∧ x ∈ fixedQueries (h.map Prod.fst) ys := by unfold follow @@ -480,13 +480,13 @@ theorem mem_follow {h : List (A × B)} {ys : List B} {x : A} : · exact ⟨fun hx => ⟨he, hx⟩, fun hx => hx.2⟩ · exact ⟨fun hx => absurd hx (Part.notMem_none _), fun hx => absurd hx.1 he⟩ -theorem cons_follow_self (h : List (A × B)) : Cons (follow h) h := by +lemma cons_follow_self (h : List (A × B)) : Cons (follow h) h := by intro i hi refine mem_follow.mpr ⟨by simp [Nat.min_eq_left hi.le], ?_⟩ simp [fixedQueries, Nat.min_eq_left hi.le, hi] /-- Before each of its queries, the environment following `h` has seen a prefix of `h`. -/ -theorem follow_prefix {h t : List (A × B)} {x : A} (hc : Cons (follow h) t) +lemma follow_prefix {h t : List (A × B)} {x : A} (hc : Cons (follow h) t) (hx : x ∈ follow h (t.map Prod.snd)) : ∃ (i : ℕ) (hi : i < h.length), t = h.take i ∧ x = (h[i]).1 := by obtain ⟨hy, hq⟩ := mem_follow.mp hx @@ -510,17 +510,17 @@ namespace RandomSystem variable [Fintype A] [Fintype B] {D : Domain A B} -theorem compatible_follow (R : RandomSystem A B D) {h : List (A × B)} +lemma compatible_follow (R : RandomSystem A B D) {h : List (A × B)} (hadm : ∀ i (hi : i < h.length), D (h.take i) (h[i]).1) : Compatible R (follow h) := by intro t x hc _ hx obtain ⟨i, hi, rfl, rfl⟩ := follow_prefix hc hx exact hadm i hi -theorem sLaw_follow (R : RandomSystem A B D) (h : List (A × B)) : +lemma sLaw_follow (R : RandomSystem A B D) (h : List (A × B)) : sLaw R (follow h) h.length h = R h := by rw [sLaw_apply, if_pos ⟨cons_follow_self h, Or.inl rfl⟩] -theorem admitted_of_ne_zero {R S : RandomSystem A B D} {h : List (A × B)} +lemma admitted_of_ne_zero {R S : RandomSystem A B D} {h : List (A × B)} (h0 : ¬ (R h = 0 ∧ S h = 0)) : ∀ i (hi : i < h.length), D (h.take i) (h[i]).1 := by intro i hi by_cases hr : R h = 0 diff --git a/src/RandomSystems/Cumulative/CumulativeOperations.lean b/src/RandomSystems/Cumulative/CumulativeOperations.lean index 985bb6f..2681470 100644 --- a/src/RandomSystems/Cumulative/CumulativeOperations.lean +++ b/src/RandomSystems/Cumulative/CumulativeOperations.lean @@ -61,7 +61,7 @@ noncomputable def mix (P : Distribution.ProbDist ι) (R : ι → RandomSystem A simp only [hw, extensionLaw_weight] by_cases hd : D h x <;> simp only [hd, if_true, if_false, mul_zero, Finset.sum_const_zero]⟩ -theorem mix_mass (P : Distribution.ProbDist ι) (R : ι → RandomSystem A B D) +lemma mix_mass (P : Distribution.ProbDist ι) (R : ι → RandomSystem A B D) (h : List (A × B)) : mix P R h = ∑ i ∈ P.1.support, P.1 i * R i h := rfl end Mix @@ -82,7 +82,7 @@ def parallelRight (h : List ((Two A C) × (Two B E))) : List (C × E) := def parallelConsistent (h : List ((Two A C) × (Two B E))) : Prop := ∀ z ∈ h, z.1.1 = z.2.1 -theorem parallelConsistent_snoc {h : List ((Two A C) × (Two B E))} {z} : +lemma parallelConsistent_snoc {h : List ((Two A C) × (Two B E))} {z} : parallelConsistent (h ++ [z]) ↔ parallelConsistent h ∧ z.1.1 = z.2.1 := by simp [parallelConsistent, or_imp, forall_and] @@ -93,7 +93,7 @@ def parallelAdmits (D : List (A × B) → A → Prop) (D' : List (C × E) → C | ⟨some (), x⟩ => D' (parallelRight h) x /-- Consistent transcripts split into their two component transcripts. -/ -theorem length_of_parallelConsistent {h : List ((Two A C) × (Two B E))} +lemma length_of_parallelConsistent {h : List ((Two A C) × (Two B E))} (hh : parallelConsistent h) : h.length = (parallelLeft h).length + (parallelRight h).length := by induction h with @@ -205,12 +205,12 @@ noncomputable def parallel (R : RandomSystem A B D) (S : RandomSystem C E D') : · rw [R.mass_eq_zero_of_bound_lt (not_le.mp hb), zero_mul, if_neg (fun h' => hb h'.2.1)]⟩ -theorem parallel_mass (R : RandomSystem A B D) (S : RandomSystem C E D') +lemma parallel_mass (R : RandomSystem A B D) (S : RandomSystem C E D') (h : List ((Two A C) × (Two B E))) : parallel R S h = if parallelConsistent h then R (parallelLeft h) * S (parallelRight h) else 0 := rfl -theorem parallel_mix_right (R : RandomSystem A B D) (P : Distribution.ProbDist ι) +lemma parallel_mix_right (R : RandomSystem A B D) (P : Distribution.ProbDist ι) (S : ι → RandomSystem C E D') : parallel R (mix P S) = mix P (fun i => parallel R (S i)) := by apply RandomSystem.ext @@ -222,7 +222,7 @@ theorem parallel_mix_right (R : RandomSystem A B D) (P : Distribution.ProbDist end Parallel -theorem parallelLeft_queries {h : List ((Two A C) × (Two B E))} +lemma parallelLeft_queries {h : List ((Two A C) × (Two B E))} (hh : parallelConsistent h) : (parallelLeft h).map Prod.fst = restrict none (h.map Prod.fst) := by induction h with @@ -233,7 +233,7 @@ theorem parallelLeft_queries {h : List ((Two A C) × (Two B E))} rcases z with ⟨⟨_ | ⟨⟩, x⟩, ⟨_ | ⟨⟩, y⟩⟩ <;> simp_all [parallelLeft] -theorem parallelRight_queries {h : List ((Two A C) × (Two B E))} +lemma parallelRight_queries {h : List ((Two A C) × (Two B E))} (hh : parallelConsistent h) : (parallelRight h).map Prod.fst = restrict (some ()) (h.map Prod.fst) := by induction h with @@ -246,7 +246,7 @@ theorem parallelRight_queries {h : List ((Two A C) × (Two B E))} /-- The existing deterministic parallel operation produces precisely the two component transcripts, interleaved in the supplied order. No totality is needed. -/ -theorem replies_pair_iff (s : System A B) (t : System C E) +lemma replies_pair_iff (s : System A B) (t : System C E) (h : List ((Two A C) × (Two B E))) : Replies (pair s t) (h.map Prod.fst) (h.map Prod.snd) ↔ parallelConsistent h ∧ @@ -286,7 +286,7 @@ variable [Fintype A] [Fintype B] [Fintype C] [Fintype E] {D : Domain A B} {D' : /-- Product cumulative behavior preserves any finite presentations of its two components, including presentations whose unreachable histories differ. -/ -theorem parallel_mass_of_presentations {ι κ : Type} +lemma parallel_mass_of_presentations {ι κ : Type} (R : RandomSystem A B D) (S : RandomSystem C E D') (P : Distribution ι) (Q : Distribution κ) (s : ι → System A B) (t : κ → System C E) @@ -305,7 +305,7 @@ theorem parallel_mass_of_presentations {ι κ : Type} /-- Parallel cumulative behavior agrees with independent sampling followed by the existing deterministic system operation. -/ -theorem parallel_ofPDS_mass +lemma parallel_ofPDS_mass {p : System A B → Prop} {q : System C E → Prop} (P : Distribution {s : System A B // p s}) (Q : Distribution {s : System C E // q s}) (hP : P.isProbDist) (hQ : Q.isProbDist) @@ -333,7 +333,7 @@ variable {A B C E : Type} [Fintype A] [Fintype B] [Fintype C] [Fintype E] omit [Fintype A] [Fintype B] [Fintype C] [Fintype E] in /-- The reachable part of a pair of samples has the parallel domain. -/ -theorem hasDomain_trim_pair {s : System A B} {t : System C E} (hs : HasDomain D s) +lemma hasDomain_trim_pair {s : System A B} {t : System C E} (hs : HasDomain D s) (ht : HasDomain D' t) : HasDomain (D.parallel D') (trim (pair s t)) := by intro h x hr rw [replies_trim_iff, RandomSystem.replies_pair_iff] at hr @@ -375,11 +375,11 @@ noncomputable def parallel (P : PDS A B D) (Q : PDS C E D') : PDS (Two A C) (Two hasDomain_trim_pair st.1.2.2 st.2.2.2⟩) (Distribution.prod P Q) -theorem parallel_isProbDist {P : PDS A B D} {Q : PDS C E D'} +lemma parallel_isProbDist {P : PDS A B D} {Q : PDS C E D'} (hP : P.isProbDist) (hQ : Q.isProbDist) : (parallel P Q).isProbDist := Distribution.fTransform_isProbDist _ (Distribution.prod_isProbDist P Q hP hQ) -theorem parallel_mass (P : PDS A B D) (Q : PDS C E D') +lemma parallel_mass (P : PDS A B D) (Q : PDS C E D') (h : List ((Two A C) × (Two B E))) : behaviorMass (parallel P Q) (h.map Prod.fst) (h.map Prod.snd) = if RandomSystem.parallelConsistent h then diff --git a/src/RandomSystems/Cumulative/Presentation.lean b/src/RandomSystems/Cumulative/Presentation.lean index a043423..e3a1622 100644 --- a/src/RandomSystems/Cumulative/Presentation.lean +++ b/src/RandomSystems/Cumulative/Presentation.lean @@ -42,12 +42,12 @@ transcript, a reply or no reply. -/ noncomputable def realization (g : List (A × B) → A → Option B) : DDS A B := DDS.ofConditional fun h x => (g h x : Part B) -theorem realization_snoc (g : List (A × B) → A → Option B) {h : List (A × B)} +lemma realization_snoc (g : List (A × B) → A → Option B) {h : List (A × B)} (hr : Replies (realization g).1 (h.map Prod.fst) (h.map Prod.snd)) (x : A) : (realization g).1 (h.map Prod.fst ++ [x]) = (g h x : Part B) := DDS.ofConditional_snoc _ hr x -theorem replies_realization_snoc (g : List (A × B) → A → Option B) (t : List (A × B)) +lemma replies_realization_snoc (g : List (A × B) → A → Option B) (t : List (A × B)) (x : A) (y : B) : Replies (realization g).1 ((t ++ [(x, y)]).map Prod.fst) ((t ++ [(x, y)]).map Prod.snd) ↔ Replies (realization g).1 (t.map Prod.fst) (t.map Prod.snd) ∧ g t x = some y := by @@ -64,7 +64,7 @@ theorem replies_realization_snoc (g : List (A × B) → A → Option B) (t : Lis exact replies_snoc.mpr ⟨hr, by rw [realization_snoc g hr, hg]; rfl⟩ /-- Reply events depend only on the choices at strictly shorter transcripts. -/ -theorem replies_realization_congr (t : List (A × B)) (g g' : List (A × B) → A → Option B) +lemma replies_realization_congr (t : List (A × B)) (g g' : List (A × B) → A → Option B) (hg : ∀ h x, h.length < t.length → g h x = g' h x) : Replies (realization g).1 (t.map Prod.fst) (t.map Prod.snd) ↔ Replies (realization g').1 (t.map Prod.fst) (t.map Prod.snd) := by @@ -115,7 +115,7 @@ stopping is possible. -/ def PossibleChoice (g : List (A × B) → A → Option B) : Prop := ∀ h x, g h x ∈ (hp.replyChoice h x).support -theorem replyChoice_none (h : List (A × B)) (x : A) : +lemma replyChoice_none (h : List (A × B)) (x : A) : hp.replyChoice h x none = 1 - (hp.extensionLaw h x).weight / p h := by simp only [replyChoice, Finsupp.add_apply, Finsupp.single_apply, if_true] have h0 : Distribution.fTransform some @@ -123,7 +123,7 @@ theorem replyChoice_none (h : List (A × B)) (x : A) : Finsupp.mapDomain_of_notMem_range _ _ (by rintro ⟨b, hb⟩; cases hb) rw [h0, zero_add, Distribution.weight_mapRange_div] -theorem replyChoice_support_nonempty (h : List (A × B)) (x : A) : +lemma replyChoice_support_nonempty (h : List (A × B)) (x : A) : (hp.replyChoice h x).support.Nonempty := by apply Finsupp.support_nonempty_iff.mpr intro hz @@ -132,7 +132,7 @@ theorem replyChoice_support_nonempty (h : List (A × B)) (x : A) : norm_num [Distribution.weight] at hw /-- Realizations of possible choices produce only possible transcripts. -/ -theorem realization_possible (g : List (A × B) → A → Option B) (hg : hp.PossibleChoice g) +lemma realization_possible (g : List (A × B) → A → Option B) (hg : hp.PossibleChoice g) {h : List (A × B)} (hr : Replies (realization g).1 (h.map Prod.fst) (h.map Prod.snd)) : p h ≠ 0 := by induction h using List.reverseRecOn with @@ -150,7 +150,7 @@ variable [Fintype A] [Fintype B] (n : ℕ) noncomputable def choiceLaw : Distribution (Node A B n → Option B) := pi fun j => hp.replyChoice j.1.1 j.2 -theorem choiceLaw_isProbDist : (hp.choiceLaw n).isProbDist := +lemma choiceLaw_isProbDist : (hp.choiceLaw n).isProbDist := ⟨pi_nonNeg fun j => (hp.replyChoice_isProbDist j.1.1 j.2).1, by rw [choiceLaw, weight_pi] exact Finset.prod_eq_one fun j _ => (hp.replyChoice_isProbDist j.1.1 j.2).2⟩ @@ -159,7 +159,7 @@ variable {n} omit [Fintype A] in /-- Beyond the bound, no reply is the possible choice. -/ -theorem none_mem_support {h : List (A × B)} (x : A) (hn : ∀ h, n < h.length → p h = 0) +lemma none_mem_support {h : List (A × B)} (x : A) (hn : ∀ h, n < h.length → p h = 0) (hl : ¬ h.length < n) : none ∈ (hp.replyChoice h x).support := by rw [Finsupp.mem_support_iff, hp.replyChoice_none] have hw : (hp.extensionLaw h x).weight = 0 := by @@ -171,7 +171,7 @@ theorem none_mem_support {h : List (A × B)} (x : A) (hn : ∀ h, n < h.length exact one_ne_zero /-- Supported node choices are possible choices everywhere. -/ -theorem choiceAt_supported (hn : ∀ h, n < h.length → p h = 0) {c : Node A B n → Option B} +lemma choiceAt_supported (hn : ∀ h, n < h.length → p h = 0) {c : Node A B n → Option B} (hc : c ∈ (hp.choiceLaw n).support) : hp.PossibleChoice (choiceAt c) := by intro h x unfold choiceAt @@ -183,7 +183,7 @@ theorem choiceAt_supported (hn : ∀ h, n < h.length → p h = 0) {c : Node A B · exact hp.none_mem_support x hn hl /-- The chain rule: the reply masses of the realizations are the cumulative masses. -/ -theorem mass_replies (hn : ∀ h, n < h.length → p h = 0) (t : List (A × B)) : +lemma mass_replies (hn : ∀ h, n < h.length → p h = 0) (t : List (A × B)) : (hp.choiceLaw n).mass (fun c => Replies (realization (choiceAt c)).1 (t.map Prod.fst) (t.map Prod.snd)) = p t := by induction t using List.reverseRecOn with @@ -254,7 +254,7 @@ theorem exists_presentation (hn : ∀ h, n < h.length → p h = 0) (P : System A /-- Every possible transcript is produced by a deterministic system with every property of the realizations of possible choices. -/ -theorem exists_replies (hn : ∀ h, n < h.length → p h = 0) (P : System A B → Prop) +lemma exists_replies (hn : ∀ h, n < h.length → p h = 0) (P : System A B → Prop) (hP : ∀ g, hp.PossibleChoice g → P (realization g).1) {h : List (A × B)} (hm : p h ≠ 0) : ∃ s, P s ∧ Replies s (h.map Prod.fst) (h.map Prod.snd) := by obtain ⟨μ, hμ, -⟩ := hp.exists_presentation hn P hP @@ -269,7 +269,7 @@ namespace RandomSystem variable [Fintype A] [Fintype B] {D : Domain A B} /-- On a random system, realizations of possible choices answer exactly on its domain. -/ -theorem hasDomain_realization (R : RandomSystem A B D) {g : List (A × B) → A → Option B} +lemma hasDomain_realization (R : RandomSystem A B D) {g : List (A × B) → A → Option B} (hg : R.2.isSubprobabilistic.PossibleChoice g) : HasDomain D (realization g).1 := by have hp := R.2.isSubprobabilistic @@ -309,7 +309,7 @@ theorem exists_presentation (R : RandomSystem A B D) : exact ⟨μ.1, μ.2, RandomSystem.ext fun t => hμ t⟩ /-- Random systems are exactly the classes of equivalent finite PDSs. -/ -theorem ofPDSClass_bijective (D : Domain A B) : +lemma ofPDSClass_bijective (D : Domain A B) : Function.Bijective (ofPDSClass (A := A) (B := B) D) := by refine ⟨ofPDSClass_injective, fun R => ?_⟩ obtain ⟨P, hP, hR⟩ := exists_presentation R diff --git a/src/RandomSystems/Cumulative/Subprobability.lean b/src/RandomSystems/Cumulative/Subprobability.lean index 9de2821..337ef20 100644 --- a/src/RandomSystems/Cumulative/Subprobability.lean +++ b/src/RandomSystems/Cumulative/Subprobability.lean @@ -38,7 +38,7 @@ def NormalizedOn (D : List (A × B) → A → Prop) (p : List (A × B) → ℝ) ∀ h x (μ : Distribution B), (∀ y, μ y = p (h ++ [(x, y)])) → μ.weight = if D h x then p h else 0 -theorem IsRandomSystem.isSubprobabilistic {D : List (A × B) → A → Prop} +lemma IsRandomSystem.isSubprobabilistic {D : List (A × B) → A → Prop} {p : List (A × B) → ℝ} (hp : IsRandomSystem D p) : IsSubprobabilistic p := by refine ⟨hp.1, hp.2.1, fun h x => ?_⟩ obtain ⟨μ, hμ, hw⟩ := hp.2.2 h x @@ -48,7 +48,7 @@ theorem IsRandomSystem.isSubprobabilistic {D : List (A × B) → A → Prop} · exact le_rfl · exact hp.2.1 h -theorem isRandomSystem_iff_normalizedOn {D : List (A × B) → A → Prop} +lemma isRandomSystem_iff_normalizedOn {D : List (A × B) → A → Prop} {p : List (A × B) → ℝ} : IsRandomSystem D p ↔ IsSubprobabilistic p ∧ NormalizedOn D p := by constructor @@ -62,7 +62,7 @@ theorem isRandomSystem_iff_normalizedOn {D : List (A × B) → A → Prop} obtain ⟨μ, hμ, _⟩ := hp.2.2 h x exact ⟨μ, hμ, hd h x μ hμ⟩ -theorem isSubprobabilistic_behaviorMass {P : System A B → Prop} +lemma isSubprobabilistic_behaviorMass {P : System A B → Prop} (μ : Distribution {s : System A B // P s}) (hμ : μ.isProbDist) : IsSubprobabilistic (fun h => behaviorMass μ (h.map Prod.fst) (h.map Prod.snd)) := by refine ⟨?_, fun h => hμ.1.mass_nonneg _, fun h x => ?_⟩ @@ -78,20 +78,20 @@ variable {p : List (A × B) → ℝ} (hp : IsSubprobabilistic p) noncomputable def extensionLaw (h : List (A × B)) (x : A) : Distribution B := (hp.2.2 h x).choose -theorem extensionLaw_apply (h : List (A × B)) (x : A) (y : B) : +lemma extensionLaw_apply (h : List (A × B)) (x : A) (y : B) : hp.extensionLaw h x y = p (h ++ [(x, y)]) := (hp.2.2 h x).choose_spec.1 y -theorem extensionLaw_nonneg (h : List (A × B)) (x : A) : +lemma extensionLaw_nonneg (h : List (A × B)) (x : A) : (hp.extensionLaw h x).NonNeg := by intro y rw [hp.extensionLaw_apply] exact hp.2.1 _ -theorem extensionLaw_weight_le (h : List (A × B)) (x : A) : +lemma extensionLaw_weight_le (h : List (A × B)) (x : A) : (hp.extensionLaw h x).weight ≤ p h := (hp.2.2 h x).choose_spec.2 include hp in -theorem mass_snoc_le (h : List (A × B)) (x : A) (y : B) : +lemma mass_snoc_le (h : List (A × B)) (x : A) (y : B) : p (h ++ [(x, y)]) ≤ p h := by rw [← hp.extensionLaw_apply] exact ((Distribution.apply_le_mass (hp.extensionLaw_nonneg h x) rfl).trans @@ -99,7 +99,7 @@ theorem mass_snoc_le (h : List (A × B)) (x : A) (y : B) : (hp.extensionLaw_weight_le h x) include hp in -theorem mass_eq_zero_of_prefix {h k : List (A × B)} (hk : h <+: k) (hz : p h = 0) : +lemma mass_eq_zero_of_prefix {h k : List (A × B)} (hk : h <+: k) (hz : p h = 0) : p k = 0 := by obtain ⟨e, rfl⟩ := hk induction e using List.reverseRecOn with @@ -114,14 +114,14 @@ noncomputable def replyChoice (h : List (A × B)) (x : A) : Distribution (Option let μ : Distribution B := (hp.extensionLaw h x).mapRange (fun w => w / p h) (zero_div _) Distribution.fTransform some μ + Finsupp.single none (1 - μ.weight) -theorem replyChoice_some (h : List (A × B)) (x : A) (y : B) : +lemma replyChoice_some (h : List (A × B)) (x : A) (y : B) : hp.replyChoice h x (some y) = p (h ++ [(x, y)]) / p h := by simp only [replyChoice, Finsupp.add_apply, Distribution.fTransform_injective_apply _ _ (Option.some_injective B), Finsupp.mapRange_apply, hp.extensionLaw_apply, Finsupp.single_apply, reduceCtorEq, if_false, add_zero] -theorem replyChoice_isProbDist (h : List (A × B)) (x : A) : +lemma replyChoice_isProbDist (h : List (A × B)) (x : A) : (hp.replyChoice h x).isProbDist := by let μ : Distribution B := (hp.extensionLaw h x).mapRange (fun w => w / p h) (zero_div _) have hn : μ.NonNeg := fun y => div_nonneg (hp.extensionLaw_nonneg h x y) (hp.2.1 h) diff --git a/src/RandomSystems/DDC/Absorb.lean b/src/RandomSystems/DDC/Absorb.lean index 0a6673e..877d93e 100644 --- a/src/RandomSystems/DDC/Absorb.lean +++ b/src/RandomSystems/DDC/Absorb.lean @@ -63,7 +63,7 @@ noncomputable def absorbL (D : DDD (Free (alongSet (O := O) ι)) (fun _ => X) (f interconnect (pair D α) (abRoute ι) (abInj ι) /-- Every internal cycle of `D ⋄ α` passes through `D`: `α` answers `D` or leaves. -/ -theorem abRoute_cyclesThrough : CyclesThrough (fun _ => True) (abRoute (X := X) (Y := Y) (O := O) ι) := by +lemma abRoute_cyclesThrough : CyclesThrough (fun _ => True) (abRoute (X := X) (Y := Y) (O := O) ι) := by refine ⟨fun _ h => absurd trivial h, fun y _ => ?_, fun y => ?_⟩ · rcases y with ⟨_ | _ | ⟨⟨_ | ⟨⟨⟩⟩, l⟩, h⟩, v⟩ · exact v.elim @@ -148,7 +148,7 @@ theorem close_attachL (D : DDD (Free (alongSet (O := O) ι)) (fun _ => X) (fun _ · exact absurd (sys_mem_closeSet z) hz /-- The decision of `D ▹ (α^ι R)` is the decision of `(D ⋄ α) ▹ R`. -/ -theorem decision_attachL (D : DDD (Free (alongSet (O := O) ι)) (fun _ => X) (fun _ => Y)) +lemma decision_attachL (D : DDD (Free (alongSet (O := O) ι)) (fun _ => X) (fun _ => Y)) (α : SingleAlphabetConverter X Y O J) (R : SingleAlphabetSystem X Y K) (hD : Terminating D) (hα : IsResponsiveDDC b α) (c : Bool) : decOut c ∈ close D (attachL ι α R) [startIn] ↔ decOut c ∈ close (absorbL ι D α) R [startIn] := by rw [close_attachL D α R hD hα] @@ -176,7 +176,7 @@ def outerCount (h : List (Σ l, twoFam U Yi l)) : ℕ := h.countP (fun z => deci /-- The number of inside inputs of a converter history. -/ def innerCount (h : List (Σ l, twoFam U Yi l)) : ℕ := h.countP (fun z => !decide (z.1.1 = none)) -theorem outerCount_add_innerCount (h : List (Σ l, twoFam U Yi l)) : +lemma outerCount_add_innerCount (h : List (Σ l, twoFam U Yi l)) : outerCount h + innerCount h = h.length := by induction h with | nil => rfl @@ -184,24 +184,24 @@ theorem outerCount_add_innerCount (h : List (Σ l, twoFam U Yi l)) : by_cases hz : z.1.1 = none <;> simp [outerCount, innerCount, List.countP_cons, hz] at ih ⊢ <;> omega -theorem outerCount_snoc (h : List (Σ l, twoFam U Yi l)) (z : Σ l, twoFam U Yi l) : +lemma outerCount_snoc (h : List (Σ l, twoFam U Yi l)) (z : Σ l, twoFam U Yi l) : outerCount (h ++ [z]) = outerCount h + if z.1.1 = none then 1 else 0 := by simp [outerCount, List.countP_append] -theorem innerCount_snoc (h : List (Σ l, twoFam U Yi l)) (z : Σ l, twoFam U Yi l) : +lemma innerCount_snoc (h : List (Σ l, twoFam U Yi l)) (z : Σ l, twoFam U Yi l) : innerCount (h ++ [z]) = innerCount h + if z.1.1 = none then 0 else 1 := by by_cases hz : z.1.1 = none <;> simp [innerCount, List.countP_append, hz] variable {b : ℕ} {α : InsideOutsideSystem O J U V Xi Yi} -theorem replyLabel_nil_of_silentAtEmpty (hα : IsDDC b α) : replyLabel α [] = none := by +lemma replyLabel_nil_of_silentAtEmpty (hα : IsDDC b α) : replyLabel α [] = none := by have h := hα.dds.1 simp only [SilentAtEmpty] at h simp [replyLabel, h] /-- Inside inputs of an answered history: each outside call is followed by at most `b` inside calls. The first component is the invariant while an inside call is open. -/ -theorem IsDDC.count_le (hα : IsDDC b α) : +lemma IsDDC.count_le (hα : IsDDC b α) : ∀ h, (α h).Dom → ∀ y ∈ α h, (IsInside y → innerCount h + 1 + b ≤ b * outerCount h + insideRun α h) ∧ (¬ IsInside y → innerCount h ≤ b * outerCount h) := by @@ -246,7 +246,7 @@ theorem IsDDC.count_le (hα : IsDDC b α) : simp only [hz, reduceCtorEq, if_false, if_true, Nat.add_zero] at * constructor <;> intro hi <;> (try simp only [hi, if_true, if_false]) <;> omega -theorem IsDDC.innerCount_le (hα : IsDDC b α) {h} (hd : (α h).Dom) : +lemma IsDDC.innerCount_le (hα : IsDDC b α) {h} (hd : (α h).Dom) : innerCount h ≤ b * outerCount h := by obtain ⟨h₁, h₂⟩ := hα.count_le h hd _ (Part.get_mem hd) by_cases hi : IsInside ((α h).get hd) @@ -289,7 +289,7 @@ def ACnt (G : List (Two (Σ p : DPort (Free (alongSet (O := O) ι)), dIn (fun _ outerCount (restrict (some ()) G) ≤ (restrict none G).length ∧ (restrict (some ()) G = [] ∨ (α (restrict (some ()) G)).Dom) -theorem ab_exchange {G o G'} (l : Exchange (pair D α) (abRoute ι) G o G') : +lemma ab_exchange {G o G'} (l : Exchange (pair D α) (abRoute ι) G o G') : ∀ out, o = some out → ((∃ G₁ x, G = G₁ ++ [⟨none, x⟩] ∧ Reach D (restrict none G₁) ∧ AIdle α G₁ ∧ ACnt α G₁) ∨ (∃ G₁ x, G = G₁ ++ [⟨some (), x⟩] ∧ Reach D (restrict none G₁) ∧ @@ -380,7 +380,7 @@ def AbInv (u : List (Σ p : DPort K, dIn (fun _ : K => Y) p)) (u = [] ↔ restrict none H = []) ∧ (u = [] → H = []) ∧ ACnt α H ∧ ∀ l, replyLabel (absorbL ι D α) u = some l → ARel D α l H -theorem ab_step (hD : IsDDD D) (hα : IsResponsiveDDC b α) {u H} (inv : AbInv D α u H) +lemma ab_step (hD : IsDDD D) (hα : IsResponsiveDDC b α) {u H} (inv : AbInv D α u H) {z : Σ p : DPort K, dIn (fun _ : K => Y) p} (hr : Reach (absorbL ι D α) (u ++ [z])) : (u = [] ↔ z.1 = .start) ∧ (∀ k, replyLabel (absorbL ι D α) u = some (.res k) → z.1 = .res k) ∧ @@ -504,7 +504,7 @@ theorem ab_step (hD : IsDDD D) (hα : IsResponsiveDDC b α) {u H} (inv : AbInv D /-- **`D ⋄ α` is a distinguisher** (spec §5.6): with bound `(b + 2) n` for a distinguisher with bound `n` and a converter with at most `b` consecutive inside calls. Neither the converter nor the resource needs a finite lifetime. -/ -theorem absorbL_inv (hD : IsDDD D) (hα : IsResponsiveDDC b α) : +lemma absorbL_inv (hD : IsDDD D) (hα : IsResponsiveDDC b α) : ∀ u, Reach (absorbL ι D α) u → ∃ H, AbInv D α u H := by intro u induction u using List.reverseRecOn with @@ -519,7 +519,7 @@ theorem absorbL_inv (hD : IsDDD D) (hα : IsResponsiveDDC b α) : exact (ab_step hD hα hinv hr).2.2.2 /-- The explicit query bound of `D ⋄ α`: `(b + 2) n` for a bound `n` of `D`. -/ -theorem absorbL_finite (hD : IsDDD D) (hα : IsResponsiveDDC b α) {nD : ℕ} (hnD : Finite nD D) : +lemma absorbL_finite (hD : IsDDD D) (hα : IsResponsiveDDC b α) {nD : ℕ} (hnD : Finite nD D) : Finite ((b + 2) * nD) (trim (absorbL ι D α)) := by set γ := absorbL ι D α have inv := absorbL_inv hD hα @@ -544,7 +544,7 @@ theorem absorbL_finite (hD : IsDDD D) (hα : IsResponsiveDDC b α) {nD : ℕ} (h have h2 : (b + 2) * nD = nD + (b + 1) * nD := by rw [Nat.succ_mul]; omega omega -theorem absorbL_isDDD (hD : IsDDD D) (hα : IsResponsiveDDC b α) : +lemma absorbL_isDDD (hD : IsDDD D) (hα : IsResponsiveDDC b α) : IsDDD (trim (absorbL ι D α)) := by set γ := absorbL ι D α have inv := absorbL_inv hD hα diff --git a/src/RandomSystems/DDC/CanonWiring.lean b/src/RandomSystems/DDC/CanonWiring.lean index 0f02d56..5bb900a 100644 --- a/src/RandomSystems/DDC/CanonWiring.lean +++ b/src/RandomSystems/DDC/CanonWiring.lean @@ -26,7 +26,7 @@ variable {O M J : Type} {U V : O → Type} {Xm Ym : M → Type} {X Y : J → Typ /-- Canonical restriction changes no value at a prefix of admissible component histories. -/ -theorem pair_canon_eq_of_admissible {β : InsideOutsideSystem O M U V Xm Ym} {α : InsideOutsideSystem M J Xm Ym X Y} +lemma pair_canon_eq_of_admissible {β : InsideOutsideSystem O M U V Xm Ym} {α : InsideOutsideSystem M J Xm Ym X Y} {H : List (Two (Σ l, twoFam U Ym l) (Σ l, twoFam Xm Y l))} (hβ : Admissible β (restrict none H)) (hα : Admissible α (restrict (some ()) H)) : ∀ p, p <+: H → pair (canon β) (canon α) p = pair β α p := by @@ -47,7 +47,7 @@ theorem pair_canon_eq_of_admissible {β : InsideOutsideSystem O M U V Xm Ym} {α rw [canon_of_admissible hα.of_append] /-- A reached serial state has admissible component histories. -/ -theorem SerialState.admissible {bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} {α : InsideOutsideSystem M J Xm Ym X Y} +lemma SerialState.admissible {bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} {α : InsideOutsideSystem M J Xm Ym X Y} {u : List (Σ l : Two O J, twoFam U Y l)} {w} {H} (hs : SerialState β α bα u (some w) H) : Admissible β (restrict none H) ∧ Admissible α (restrict (some ()) H) := by @@ -57,7 +57,7 @@ theorem SerialState.admissible {bα : ℕ} {β : InsideOutsideSystem O M U V Xm · exact ⟨hwb.1, hwa.1⟩ /-- **Canonical restriction commutes with serial wiring** on admitted histories. -/ -theorem replies_serialM_canon_iff {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} +lemma replies_serialM_canon_iff {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} {α : InsideOutsideSystem M J Xm Ym X Y} (hβ : IsDDC bβ (canon β)) (hα : IsDDC bα (canon α)) : ∀ h : List ((Σ l, twoFam U Y l) × (Σ l, twoFam V X l)), Admitted converterAdmits h → (Replies (serialM (canon β) (canon α)) (h.map Prod.fst) (h.map Prod.snd) ↔ diff --git a/src/RandomSystems/DDC/DDC.lean b/src/RandomSystems/DDC/DDC.lean index 289af1b..cf99457 100644 --- a/src/RandomSystems/DDC/DDC.lean +++ b/src/RandomSystems/DDC/DDC.lean @@ -60,7 +60,7 @@ def admitAfter : Option (Two O J) → Two O J → Prop | some ⟨some (), j⟩, l => l = ⟨some (), j⟩ | _, l => l.1 = none -theorem admitAfter_of_ne {r : Option (Two O J)} (hr : ∀ j, r ≠ some ⟨some (), j⟩) {l : Two O J} : +lemma admitAfter_of_ne {r : Option (Two O J)} (hr : ∀ j, r ≠ some ⟨some (), j⟩) {l : Two O J} : admitAfter r l ↔ l.1 = none := by rcases r with _ | ⟨_ | ⟨⟨⟩⟩, j⟩ · rfl @@ -76,7 +76,7 @@ def outerOf {F : Two O J → Type} : (Σ l, F l) → Option O def lastOuter {F : Two O J → Type} (h : List (Σ l, F l)) : Option O := h.reverse.findSome? outerOf -theorem lastOuter_snoc {F : Two O J → Type} (h : List (Σ l, F l)) (z : Σ l, F l) : +lemma lastOuter_snoc {F : Two O J → Type} (h : List (Σ l, F l)) (z : Σ l, F l) : lastOuter (h ++ [z]) = (outerOf z).or (lastOuter h) := by simp only [lastOuter, List.reverse_append, List.reverse_cons, List.reverse_nil, List.nil_append, List.singleton_append, List.findSome?_cons] @@ -95,11 +95,11 @@ def Admissible (α : InsideOutsideSystem O J U V Xi Yi) (h : List (Σ l, twoFam variable {α : InsideOutsideSystem O J U V Xi Yi} -@[simp] theorem admissible_nil : Admissible α [] := by +@[simp] lemma admissible_nil : Admissible α [] := by intro h' z e he simp at he -theorem admissible_snoc {h : List (Σ l, twoFam U Yi l)} {z : Σ l, twoFam U Yi l} : +lemma admissible_snoc {h : List (Σ l, twoFam U Yi l)} {z : Σ l, twoFam U Yi l} : Admissible α (h ++ [z]) ↔ Admissible α h ∧ (h ≠ [] → (α h).Dom) ∧ Admits α h z := by constructor · intro ha @@ -115,7 +115,7 @@ theorem admissible_snoc {h : List (Σ l, twoFam U Yi l)} {z : Σ l, twoFam U Yi obtain ⟨rfl, -⟩ := List.append_inj' he' rfl exact ha h' z' e' rfl -theorem Admissible.of_append {h e : List (Σ l, twoFam U Yi l)} (ha : Admissible α (h ++ e)) : +lemma Admissible.of_append {h e : List (Σ l, twoFam U Yi l)} (ha : Admissible α (h ++ e)) : Admissible α h := fun h' z e' he => ha h' z (e' ++ e) (by rw [he]; simp) @@ -138,7 +138,7 @@ abbrev DDC (O J : Type) (U V : O → Type) (X Y : J → Type) := def Responsive (α : InsideOutsideSystem O J U V Xi Yi) : Prop := ∀ h, Admissible α h → h ≠ [] → (α h).Dom -theorem IsDDC.mono {b c : ℕ} (hα : IsDDC b α) (hbc : b ≤ c) : IsDDC c α := +lemma IsDDC.mono {b c : ℕ} (hα : IsDDC b α) (hbc : b ≤ c) : IsDDC c α := { hα with bound := fun h hd => (hα.bound h hd).trans hbc } /-- **Responsive converter** (Jost Def. 2.2.2, printed pp. 17–18): a deterministic system that @@ -155,20 +155,20 @@ structure IsResponsiveDDC (b : ℕ) (α : InsideOutsideSystem O J U V Xi Yi) : P responsive : Responsive α replies : ∀ h y (o : O), y ∈ α h → y.1 = ⟨none, o⟩ → lastOuter h = some o -theorem IsResponsiveDDC.isDDC {b : ℕ} (hα : IsResponsiveDDC b α) : IsDDC b α := +lemma IsResponsiveDDC.isDDC {b : ℕ} (hα : IsResponsiveDDC b α) : IsDDC b α := ⟨hα.dds, hα.admits, hα.bound, hα.replies⟩ /-- The responsive specialization adds exactly its reply obligation. -/ -theorem isResponsiveDDC_iff {b : ℕ} : +lemma isResponsiveDDC_iff {b : ℕ} : IsResponsiveDDC b α ↔ IsDDC b α ∧ Responsive α := ⟨fun h => ⟨h.isDDC, h.responsive⟩, fun ⟨h, hr⟩ => ⟨h.dds, h.admits, h.bound, hr, h.replies⟩⟩ -theorem IsResponsiveDDC.mono {b b' : ℕ} (hα : IsResponsiveDDC b α) (hb : b ≤ b') : +lemma IsResponsiveDDC.mono {b b' : ℕ} (hα : IsResponsiveDDC b α) (hb : b ≤ b') : IsResponsiveDDC b' α := { hα with bound := fun h hd => (hα.bound h hd).trans hb } -theorem IsResponsiveDDC.admissible {b : ℕ} (hα : IsResponsiveDDC b α) {h : List (Σ l, twoFam U Yi l)} +lemma IsResponsiveDDC.admissible {b : ℕ} (hα : IsResponsiveDDC b α) {h : List (Σ l, twoFam U Yi l)} (hd : (α h).Dom) : Admissible α h := by intro h' z e he subst he @@ -177,7 +177,7 @@ theorem IsResponsiveDDC.admissible {b : ℕ} (hα : IsResponsiveDDC b α) {h : L refine ⟨fun hne => hα.dds.2 ⟨z :: e, rfl⟩ hne hd, hα.admits h' z hz⟩ /-- A converter answers exactly the nonempty admissible histories. -/ -theorem IsResponsiveDDC.dom_iff {b : ℕ} (hα : IsResponsiveDDC b α) (h : List (Σ l, twoFam U Yi l)) : +lemma IsResponsiveDDC.dom_iff {b : ℕ} (hα : IsResponsiveDDC b α) (h : List (Σ l, twoFam U Yi l)) : (α h).Dom ↔ h ≠ [] ∧ Admissible α h := ⟨fun hd => ⟨by rintro rfl; exact hα.dds.1 hd, hα.admissible hd⟩, fun ⟨hne, ha⟩ => hα.responsive h ha hne⟩ @@ -194,14 +194,14 @@ variable {O J : Type} {U V : O → Type} {Xi Yi : J → Type} noncomputable def canon (c : InsideOutsideSystem O J U V Xi Yi) : InsideOutsideSystem O J U V Xi Yi := fun h => if Admissible c h then c h else Part.none -theorem canon_of_admissible {c : InsideOutsideSystem O J U V Xi Yi} {h} (ha : Admissible c h) : +lemma canon_of_admissible {c : InsideOutsideSystem O J U V Xi Yi} {h} (ha : Admissible c h) : canon c h = c h := if_pos ha -theorem replyLabel_canon {c : InsideOutsideSystem O J U V Xi Yi} {h} (ha : Admissible c h) : +lemma replyLabel_canon {c : InsideOutsideSystem O J U V Xi Yi} {h} (ha : Admissible c h) : replyLabel (canon c) h = replyLabel c h := by simp [replyLabel, canon_of_admissible ha] -theorem admissible_canon_iff {c : InsideOutsideSystem O J U V Xi Yi} (h : List (Σ l, twoFam U Yi l)) : +lemma admissible_canon_iff {c : InsideOutsideSystem O J U V Xi Yi} (h : List (Σ l, twoFam U Yi l)) : Admissible (canon c) h ↔ Admissible c h := by induction h using List.reverseRecOn with | nil => simp @@ -230,31 +230,31 @@ noncomputable def idConverter : InsideOutsideSystem J J X Y X Y := canon (forwar variable {J X Y} -theorem forwardAll_snoc_outer (h : List (Σ l, twoFam X Y l)) (j : J) (x : X j) : +lemma forwardAll_snoc_outer (h : List (Σ l, twoFam X Y l)) (j : J) (x : X j) : forwardAll J X Y (h ++ [⟨⟨none, j⟩, x⟩]) = Part.some ⟨⟨some (), j⟩, x⟩ := by simp [forwardAll] -theorem forwardAll_snoc_inner (h : List (Σ l, twoFam X Y l)) (j : J) (y : Y j) : +lemma forwardAll_snoc_inner (h : List (Σ l, twoFam X Y l)) (j : J) (y : Y j) : forwardAll J X Y (h ++ [⟨⟨some (), j⟩, y⟩]) = Part.some ⟨⟨none, j⟩, y⟩ := by simp [forwardAll] -theorem forwardAll_dom {h : List (Σ l, twoFam X Y l)} (hne : h ≠ []) : +lemma forwardAll_dom {h : List (Σ l, twoFam X Y l)} (hne : h ≠ []) : (forwardAll J X Y h).Dom := by obtain ⟨h₀, z, rfl⟩ := List.eq_nil_or_concat h |>.resolve_left hne rcases z with ⟨⟨_ | ⟨⟨⟩⟩, j⟩, v⟩ · simp [List.concat_eq_append, forwardAll_snoc_outer] · simp [List.concat_eq_append, forwardAll_snoc_inner] -theorem replyLabel_forwardAll_outer (h : List (Σ l, twoFam X Y l)) (j : J) (x : X j) : +lemma replyLabel_forwardAll_outer (h : List (Σ l, twoFam X Y l)) (j : J) (x : X j) : replyLabel (forwardAll J X Y) (h ++ [⟨⟨none, j⟩, x⟩]) = some ⟨some (), j⟩ := by simp [replyLabel, forwardAll_snoc_outer] -theorem replyLabel_forwardAll_inner (h : List (Σ l, twoFam X Y l)) (j : J) (y : Y j) : +lemma replyLabel_forwardAll_inner (h : List (Σ l, twoFam X Y l)) (j : J) (y : Y j) : replyLabel (forwardAll J X Y) (h ++ [⟨⟨some (), j⟩, y⟩]) = some ⟨none, j⟩ := by simp [replyLabel, forwardAll_snoc_inner] /-- On an admissible history, an inside input at `j` follows an outside input at `j`. -/ -theorem forwardAll_inner_prev {h : List (Σ l, twoFam X Y l)} {j : J} {y : Y j} +lemma forwardAll_inner_prev {h : List (Σ l, twoFam X Y l)} {j : J} {y : Y j} (ha : Admissible (forwardAll J X Y) (h ++ [⟨⟨some (), j⟩, y⟩])) : ∃ h₀ x, h = h₀ ++ [⟨⟨none, j⟩, x⟩] := by obtain ⟨-, -, hz⟩ := admissible_snoc.mp ha @@ -269,7 +269,7 @@ theorem forwardAll_inner_prev {h : List (Σ l, twoFam X Y l)} {j : J} {y : Y j} · rw [Admits, replyLabel_forwardAll_inner] at hz simp [admitAfter] at hz -theorem idConverter_isResponsiveDDC : IsResponsiveDDC 1 (idConverter J X Y) := by +lemma idConverter_isResponsiveDDC : IsResponsiveDDC 1 (idConverter J X Y) := by refine ⟨⟨?_, ?_⟩, ?_, ?_, ?_, ?_⟩ · simp [SilentAtEmpty, idConverter, canon, forwardAll] · intro l₁ l₂ hp hne hd @@ -348,7 +348,7 @@ section AlongConverge variable {I O J : Type} {X Y : I → Type} {U V : O → Type} /-- Every internal cycle of `α^ι R` passes through `α`, continuing only after an inside query. -/ -theorem cyclesThrough_along (ι : J → I) : +lemma cyclesThrough_along (ι : J → I) : CyclesThrough (IsInside (F := twoFam V (X ∘ ι))) (alongRoute (U := U) (Y := Y) ι) := by refine ⟨?_, ?_, ?_⟩ · rintro ⟨⟨_ | ⟨⟨⟩⟩, l⟩, v⟩ hy @@ -380,7 +380,7 @@ theorem cyclesThrough_along (ι : J → I) : rfl /-- **Attaching a converter converges**, whatever the resource. -/ -theorem IsResponsiveDDC.converges_along {b : ℕ} {ι : J → I} {α : InsideOutsideSystem O J U V (X ∘ ι) (Y ∘ ι)} +lemma IsResponsiveDDC.converges_along {b : ℕ} {ι : J → I} {α : InsideOutsideSystem O J U V (X ∘ ι) (Y ∘ ι)} (hα : IsResponsiveDDC b α) (R : InterfaceSystem I X Y) : Converges (pair α R) (alongRoute ι) (alongInj ι) := converges_pair (cyclesThrough_along ι) hα.bound @@ -397,32 +397,32 @@ variable {I O J : Type} {X Y : I → Type} {U V : O → Type} histories, at the interface queried. -/ def TotalResource (R : InterfaceSystem I X Y) : Prop := (∀ h, (R h).Dom ↔ h ≠ []) ∧ RepliesAtQueriedInterface R -theorem TotalResource.isDDS {R : InterfaceSystem I X Y} (hR : TotalResource R) : IsDDS R := +lemma TotalResource.isDDS {R : InterfaceSystem I X Y} (hR : TotalResource R) : IsDDS R := ⟨fun hd => (hR.1 []).mp hd rfl, fun l₁ _ _ hne _ => (hR.1 l₁).mpr hne⟩ variable (ι : J → I) -theorem alongRoute_outer (o : O) (v : V o) : +lemma alongRoute_outer (o : O) (v : V o) : alongRoute (X := X) (U := U) (Y := Y) ι ⟨none, ⟨⟨none, o⟩, v⟩⟩ = .inl ⟨⟨⟨none, ⟨none, o⟩⟩, outside_not_mem_alongSet ι o⟩, v⟩ := by show Sum.map id splitIn (connectRoute (alongSet ι) (alongRouting ι) ⟨⟨none, ⟨none, o⟩⟩, v⟩) = _ rw [connectRoute_of_not_mem _ (outside_not_mem_alongSet ι o)] rfl -theorem alongRoute_inside (j : J) (x : X (ι j)) : +lemma alongRoute_inside (j : J) (x : X (ι j)) : alongRoute (U := U) (V := V) (Y := Y) ι ⟨none, ⟨⟨some (), j⟩, x⟩⟩ = .inr ⟨some (), ⟨ι j, x⟩⟩ := by show Sum.map id splitIn (connectRoute (alongSet ι) (alongRouting ι) ⟨⟨none, ⟨some (), j⟩⟩, x⟩) = _ rw [connectRoute_of_mem _ (inside_mem_alongSet ι j)] rfl -theorem alongRoute_image (hι : Function.Injective ι) (j : J) (y : Y (ι j)) : +lemma alongRoute_image (hι : Function.Injective ι) (j : J) (y : Y (ι j)) : alongRoute (X := X) (U := U) (V := V) ι ⟨some (), ⟨ι j, y⟩⟩ = .inr ⟨none, ⟨⟨some (), j⟩, y⟩⟩ := by simp only [alongRoute] rw [show (joinOut ⟨some (), ⟨ι j, y⟩⟩ : Σ p : Two (Two O J) I, _) = ⟨⟨some (), ι j⟩, y⟩ from rfl, connectRoute_of_mem _ (image_mem_alongSet ι j), liftC_alongRouting_image ι hι j] rfl -theorem alongRoute_free {i : I} (hi : i ∉ Set.range ι) (y : Y i) : +lemma alongRoute_free {i : I} (hi : i ∉ Set.range ι) (y : Y i) : alongRoute (X := X) (U := U) (V := V) ι ⟨some (), ⟨i, y⟩⟩ = .inl ⟨⟨⟨some (), i⟩, sys_not_mem_alongSet ι hi⟩, y⟩ := by simp only [alongRoute] @@ -448,7 +448,7 @@ def AlongCall (α : InsideOutsideSystem O J U V (X ∘ ι) (Y ∘ ι)) (o : O) (⟨⟨some (), j⟩, x⟩ : Σ l, twoFam V (X ∘ ι) l) ∈ α (restrict none G₁) ∧ lastOuter (restrict none G₁) = some o) -theorem along_call (hι : Function.Injective ι) (hα : IsResponsiveDDC b α) (hR : TotalResource R) +lemma along_call (hι : Function.Injective ι) (hα : IsResponsiveDDC b α) (hR : TotalResource R) {G o' G'} (l : Exchange (pair α R) (alongRoute ι) G o' G') : ∀ o, AlongCall α o G → ∃ v, o' = some ⟨⟨⟨none, ⟨none, o⟩⟩, outside_not_mem_alongSet ι o⟩, v⟩ ∧ AlongIdle α G' := by @@ -512,7 +512,7 @@ theorem along_call (hι : Function.Injective ι) (hα : IsResponsiveDDC b α) (h simpa [outerOf] using hlo /-- Every external history leaves `α` idle, and each reply comes at the queried interface. -/ -theorem along_induces (hι : Function.Injective ι) (hα : IsResponsiveDDC b α) (hR : TotalResource R) +lemma along_induces (hι : Function.Injective ι) (hα : IsResponsiveDDC b α) (hR : TotalResource R) {u o H} (r : Induces (pair α R) (alongRoute ι) (alongInj ι) u o H) : AlongIdle α H ∧ ∀ u' a, u = u' ++ [a] → ∃ c, o = some c ∧ c.1 = a.1 := by induction r with @@ -554,7 +554,7 @@ theorem along_induces (hι : Function.Injective ι) (hα : IsResponsiveDDC b α) /-- **A converter on a total resource gives a total resource** (Jost p. 18): the attachment answers every nonempty history, at the interface queried. -/ -theorem IsResponsiveDDC.totalResource_along (hι : Function.Injective ι) (hα : IsResponsiveDDC b α) +lemma IsResponsiveDDC.totalResource_along (hι : Function.Injective ι) (hα : IsResponsiveDDC b α) (hR : TotalResource R) : TotalResource (attachAlong ι α R) := by rw [attachAlong_eq] refine ⟨fun u => ⟨fun hd => ?_, fun hne => ?_⟩, fun h a c hc => ?_⟩ @@ -578,7 +578,7 @@ section AlongCanon variable {I O J : Type} {X Y : I → Type} {U V : O → Type} {ι : J → I} {b : ℕ} {c : InsideOutsideSystem O J U V (X ∘ ι) (Y ∘ ι)} {R : InterfaceSystem I X Y} -theorem along_call_canon (hι : Function.Injective ι) (hc : IsResponsiveDDC b (canon c)) +lemma along_call_canon (hι : Function.Injective ι) (hc : IsResponsiveDDC b (canon c)) (hR : TotalResource R) {G o' G'} (l : Exchange (pair (canon c) R) (alongRoute ι) G o' G') : ∀ o, AlongCall (canon c) o G → Exchange (pair c R) (alongRoute ι) G o' G' := by induction l with @@ -634,7 +634,7 @@ theorem along_call_canon (hι : Function.Injective ι) (hc : IsResponsiveDDC b ( · rw [restrict_none_snoc_right, lastOuter_snoc] simpa [outerOf] using hlo -theorem along_induces_canon (hι : Function.Injective ι) (hc : IsResponsiveDDC b (canon c)) +lemma along_induces_canon (hι : Function.Injective ι) (hc : IsResponsiveDDC b (canon c)) (hR : TotalResource R) {u o H} (r : Induces (pair (canon c) R) (alongRoute ι) (alongInj ι) u o H) : Induces (pair c R) (alongRoute ι) (alongInj ι) u o H := by @@ -669,7 +669,7 @@ theorem along_induces_canon (hι : Function.Injective ι) (hc : IsResponsiveDDC /-- Restricting a converter to its admissible histories does not change its attachment to a total resource. -/ -theorem attachAlong_canon (hι : Function.Injective ι) (hc : IsResponsiveDDC b (canon c)) +lemma attachAlong_canon (hι : Function.Injective ι) (hc : IsResponsiveDDC b (canon c)) (hR : TotalResource R) : attachAlong ι (canon c) R = attachAlong ι c R := by rw [attachAlong_eq, attachAlong_eq] apply system_ext @@ -700,11 +700,11 @@ noncomputable def idAlongIn : (Σ _ : I, X) → if h : a.1 ∈ Set.range ι then ⟨⟨⟨none, ⟨none, Classical.choose h⟩⟩, outside_not_mem_alongSet ι _⟩, a.2⟩ else ⟨⟨⟨some (), a.1⟩, sys_not_mem_alongSet ι h⟩, a.2⟩ -theorem idAlongIn_of_mem {a : Σ _ : I, X} (h : a.1 ∈ Set.range ι) : +lemma idAlongIn_of_mem {a : Σ _ : I, X} (h : a.1 ∈ Set.range ι) : idAlongIn (Y := Y) ι a = ⟨⟨⟨none, ⟨none, Classical.choose h⟩⟩, outside_not_mem_alongSet ι _⟩, a.2⟩ := dif_pos h -theorem idAlongIn_of_not_mem {a : Σ _ : I, X} (h : a.1 ∉ Set.range ι) : +lemma idAlongIn_of_not_mem {a : Σ _ : I, X} (h : a.1 ∉ Set.range ι) : idAlongIn (Y := Y) ι a = ⟨⟨⟨some (), a.1⟩, sys_not_mem_alongSet ι h⟩, a.2⟩ := dif_neg h /-- Outputs of `𝟙^ι R`, read as outputs of `R`. -/ @@ -714,7 +714,7 @@ def idAlongOut : (Σ l : Free (alongSet (O := J) ι), twoFam (twoFam (fun _ : J | ⟨⟨⟨none, ⟨some (), j⟩⟩, h⟩, _⟩ => absurd (inside_mem_alongSet ι j) h | ⟨⟨⟨some (), i⟩, _⟩, y⟩ => ⟨i, y⟩ -theorem forwardAll_forwarder : +lemma forwardAll_forwarder : Forwarder (forwardAll J (fun _ : J => X) (fun _ : J => Y)) fun | ⟨⟨none, j⟩, x⟩ => ⟨⟨some (), j⟩, x⟩ | ⟨⟨some (), j⟩, y⟩ => ⟨⟨none, j⟩, y⟩ := by @@ -726,7 +726,7 @@ theorem forwardAll_forwarder : variable {ι} /-- Forwarding along `ι` is transparent. -/ -theorem attachAlong_forwardAll (hι : Function.Injective ι) (R : InterfaceSystem I (fun _ => X) (fun _ => Y)) +lemma attachAlong_forwardAll (hι : Function.Injective ι) (R : InterfaceSystem I (fun _ => X) (fun _ => Y)) (hR : SilentAtEmpty R) : relabel (attachAlong ι (forwardAll J (fun _ : J => X) (fun _ : J => Y)) R) (idAlongIn ι) (idAlongOut ι) = R := by @@ -769,7 +769,7 @@ theorem attachAlong_forwardAll (hι : Function.Injective ι) (R : InterfaceSyste /-- **Law I, identity converter.** Attaching `𝟙` along `ι` to a total resource gives back the resource, after naming the outside labels of `𝟙` by `ι`. -/ -theorem attachAlong_idConverter (hι : Function.Injective ι) {R : InterfaceSystem I (fun _ => X) (fun _ => Y)} +lemma attachAlong_idConverter (hι : Function.Injective ι) {R : InterfaceSystem I (fun _ => X) (fun _ => Y)} (hR : TotalResource R) : relabel (attachAlong ι (idConverter J (fun _ : J => X) (fun _ : J => Y)) R) (idAlongIn ι) (idAlongOut ι) = R := by @@ -791,11 +791,11 @@ def AgreesAlong (b b' : System Xb Yb) (H : List (Two Xa Xb)) : Prop := ∀ G₀ x, G₀ ++ [⟨some (), x⟩] <+: H → b (restrict (some ()) G₀ ++ [x]) = b' (restrict (some ()) G₀ ++ [x]) -theorem AgreesAlong.mono {H H'} (h : AgreesAlong (Xa := Xa) b b' H') (hp : H <+: H') : +lemma AgreesAlong.mono {H H'} (h : AgreesAlong (Xa := Xa) b b' H') (hp : H <+: H') : AgreesAlong (Xa := Xa) b b' H := fun G₀ x hG => h G₀ x (hG.trans hp) -theorem pair_congr_right {G : List (Two Xa Xb)} (h : AgreesAlong (Xa := Xa) b b' G) : +lemma pair_congr_right {G : List (Two Xa Xb)} (h : AgreesAlong (Xa := Xa) b b' G) : pair a b G = pair a b' G := by rcases List.eq_nil_or_concat G with rfl | ⟨G₀, g, rfl⟩ · simp [pair] @@ -804,7 +804,7 @@ theorem pair_congr_right {G : List (Two Xa Xb)} (h : AgreesAlong (Xa := Xa) b b' · rw [pair_left, pair_left] · rw [pair_right, pair_right, h G₀ g (List.prefix_refl _)] -theorem Exchange.congr_right {G o G'} (l : Exchange (pair a b) route G o G') +lemma Exchange.congr_right {G o G'} (l : Exchange (pair a b) route G o G') (h : AgreesAlong (Xa := Xa) b b' G') : Exchange (pair a b') route G o G' := by induction l with | silent G hd => exact Exchange.silent _ (by rwa [← pair_congr_right h]) @@ -815,7 +815,7 @@ theorem Exchange.congr_right {G o G'} (l : Exchange (pair a b) route G o G') rw [← pair_congr_right (h.mono ⟨x :: e, by rw [he]; simp⟩)] exact hy -theorem Induces.congr_right {u o H} (r : Induces (pair a b) route inj u o H) +lemma Induces.congr_right {u o H} (r : Induces (pair a b) route inj u o H) (h : AgreesAlong (Xa := Xa) b b' H) : Induces (pair a b') route inj u o H := by induction r with | nil => exact Induces.nil @@ -824,7 +824,7 @@ theorem Induces.congr_right {u o H} (r : Induces (pair a b) route inj u o H) exact Induces.snoc _ _ _ _ _ _ (ih (h.mono ⟨inj x :: e, by rw [he]; simp⟩)) (l.congr_right h) -theorem restrict_prefix {K : Type} {F : K → Type} (k : K) {G H : List (Σ k, F k)} (h : G <+: H) : +lemma restrict_prefix {K : Type} {F : K → Type} (k : K) {G H : List (Σ k, F k)} (h : G <+: H) : restrict k G <+: restrict k H := by obtain ⟨e, rfl⟩ := h exact ⟨restrict k e, by rw [restrict_append]⟩ diff --git a/src/RandomSystems/DDC/DDCParallelLaws.lean b/src/RandomSystems/DDC/DDCParallelLaws.lean index a73b7ad..ba49af0 100644 --- a/src/RandomSystems/DDC/DDCParallelLaws.lean +++ b/src/RandomSystems/DDC/DDCParallelLaws.lean @@ -24,7 +24,7 @@ namespace SystemAlgebra open Classical -theorem trim_mem {A B : Type} {s : System A B} {h y} (hy : y ∈ trim s h) : y ∈ s h := by +lemma trim_mem {A B : Type} {s : System A B} {h y} (hy : y ∈ trim s h) : y ∈ s h := by unfold trim at hy split_ifs at hy · exact hy @@ -33,7 +33,7 @@ theorem trim_mem {A B : Type} {s : System A B} {h y} (hy : y ∈ trim s h) : y variable {O J : Type} {U V : O → Type} {X Y : J → Type} /-- A common extension uniquely determines a responsive canonical converter. -/ -theorem IsResponsiveDDC.eq_of_common_replies {ba bb : ℕ} +lemma IsResponsiveDDC.eq_of_common_replies {ba bb : ℕ} {α β c : InsideOutsideSystem O J U V X Y} (ha : IsResponsiveDDC ba α) (hb : IsResponsiveDDC bb β) (hα : ∀ xs ys, Replies α xs ys → Replies c xs ys) (hβ : ∀ xs ys, Replies β xs ys → Replies c xs ys) : α = β := by @@ -75,7 +75,7 @@ variable {O' M M' J' : Type} {U V : O ⊕ O' → Type} {ba bb bc bd : ℕ} /-- Both orders connect the same four constituents. -/ -theorem serialM_tensorRaw (ha : IsDDC ba a) (hb : IsDDC bb b) : +lemma serialM_tensorRaw (ha : IsDDC ba a) (hb : IsDDC bb b) : serialM (tensorRaw a b) (tensorRaw c d) = tensorRaw (serialM a c) (serialM b d) := by simp only [serialM, tensorRaw, pair_relabel, interconnect_relabel] @@ -90,7 +90,7 @@ theorem serialM_tensorRaw (ha : IsDDC ba a) (hb : IsDDC bb b) : rcases z with ⟨⟨(_ | ⟨⟩), (i | j)⟩, z⟩ <;> rfl /-- Serial and parallel composition satisfy interchange on complete converter behavior. -/ -theorem trim_serialM_tensorL (ha : IsResponsiveDDC ba a) (hb : IsResponsiveDDC bb b) +lemma trim_serialM_tensorL (ha : IsResponsiveDDC ba a) (hb : IsResponsiveDDC bb b) (hc : IsResponsiveDDC bc c) (hd : IsResponsiveDDC bd d) : trim (serialM (tensorL a b) (tensorL c d)) = tensorL (trim (serialM a c)) (trim (serialM b d)) := by @@ -116,7 +116,7 @@ section Identity variable {J' : Type} {X Y : J ⊕ J' → Type} -theorem tensorRaw_forwardAll : +lemma tensorRaw_forwardAll : tensorRaw (U := X) (V := Y) (Xi := X) (Yi := Y) (forwardAll J (X ∘ Sum.inl) (Y ∘ Sum.inl)) (forwardAll J' (X ∘ Sum.inr) (Y ∘ Sum.inr)) = forwardAll (J ⊕ J') X Y := by @@ -129,7 +129,7 @@ theorem tensorRaw_forwardAll : Part.map_some, tOut] /-- Parallel identity converters forward the combined interface family unchanged. -/ -theorem tensorL_id : +lemma tensorL_id : tensorL (U := X) (V := Y) (Xi := X) (Yi := Y) (idConverter J (X ∘ Sum.inl) (Y ∘ Sum.inl)) (idConverter J' (X ∘ Sum.inr) (Y ∘ Sum.inr)) = idConverter (J ⊕ J') X Y := by diff --git a/src/RandomSystems/DDC/DDCRelabel.lean b/src/RandomSystems/DDC/DDCRelabel.lean index 1b19940..cd54c85 100644 --- a/src/RandomSystems/DDC/DDCRelabel.lean +++ b/src/RandomSystems/DDC/DDCRelabel.lean @@ -37,14 +37,14 @@ def outsideMap (f : (Σ o, U o) → (Σ o, U' o)) : | ⟨⟨none, o⟩, u⟩ => ⟨⟨none, (f ⟨o, u⟩).1⟩, (f ⟨o, u⟩).2⟩ | ⟨⟨some (), j⟩, y⟩ => ⟨⟨some (), j⟩, y⟩ -theorem outsideMap_fst (e : O → O') (f : (Σ o, U o) → (Σ o, U' o)) +lemma outsideMap_fst (e : O → O') (f : (Σ o, U o) → (Σ o, U' o)) (hf : ∀ u, (f u).1 = e u.1) (z : Σ l, twoFam U Y l) : (outsideMap f z).1 = twoMap e id z.1 := by rcases z with ⟨⟨(_ | ⟨⟨⟩⟩), i⟩, z⟩ · exact congrArg (Sigma.mk none) (hf ⟨i, z⟩) · rfl -theorem isInside_outsideMap (f : (Σ o, V o) → (Σ o, V' o)) (z : Σ l, twoFam V X l) : +lemma isInside_outsideMap (f : (Σ o, V o) → (Σ o, V' o)) (z : Σ l, twoFam V X l) : IsInside (outsideMap f z) ↔ IsInside z := by rcases z with ⟨⟨(_ | ⟨⟨⟩⟩), i⟩, z⟩ <;> rfl @@ -54,7 +54,7 @@ variable (e : O' ≃ O) (f : (Σ o, U' o) → (Σ o, U o)) (α : InsideOutsideSystem O J U V X Y) include hg in -theorem replyLabel_outsideMap (h : List (Σ l, twoFam U' Y l)) : +lemma replyLabel_outsideMap (h : List (Σ l, twoFam U' Y l)) : replyLabel (relabel α (outsideMap f) (outsideMap g)) h = (replyLabel α (h.map (outsideMap f))).map (twoMap e.symm id) := by unfold replyLabel @@ -69,7 +69,7 @@ theorem replyLabel_outsideMap (h : List (Σ l, twoFam U' Y l)) : rfl include hf hg in -theorem admits_outsideMap (h : List (Σ l, twoFam U' Y l)) (z : Σ l, twoFam U' Y l) : +lemma admits_outsideMap (h : List (Σ l, twoFam U' Y l)) (z : Σ l, twoFam U' Y l) : Admits (relabel α (outsideMap f) (outsideMap g)) h z ↔ Admits α (h.map (outsideMap f)) (outsideMap f z) := by unfold Admits @@ -78,7 +78,7 @@ theorem admits_outsideMap (h : List (Σ l, twoFam U' Y l)) (z : Σ l, twoFam U' rcases z with ⟨⟨(_ | ⟨⟨⟩⟩), j⟩, z⟩ <;> simp [admitAfter, twoMap] include hf hg in -theorem admissible_outsideMap (h : List (Σ l, twoFam U' Y l)) : +lemma admissible_outsideMap (h : List (Σ l, twoFam U' Y l)) : Admissible (relabel α (outsideMap f) (outsideMap g)) h ↔ Admissible α (h.map (outsideMap f)) := by induction h using List.reverseRecOn with @@ -90,7 +90,7 @@ theorem admissible_outsideMap (h : List (Σ l, twoFam U' Y l)) : have hn : h.map (outsideMap f) ≠ [] ↔ h ≠ [] := not_congr List.map_eq_nil_iff exact and_congr Iff.rfl (and_congr (imp_congr hn.symm Iff.rfl) Iff.rfl) -theorem insideRun_outsideMap (h : List (Σ l, twoFam U' Y l)) : +lemma insideRun_outsideMap (h : List (Σ l, twoFam U' Y l)) : insideRun (relabel α (outsideMap f) (outsideMap g)) h = insideRun α (h.map (outsideMap f)) := by induction h using List.reverseRecOn with @@ -104,7 +104,7 @@ theorem insideRun_outsideMap (h : List (Σ l, twoFam U' Y l)) : fun ⟨y, hy, hi⟩ => ⟨_, ⟨y, hy, rfl⟩, (isInside_outsideMap g y).mpr hi⟩⟩ include hf in -theorem lastOuter_outsideMap (h : List (Σ l, twoFam U' Y l)) : +lemma lastOuter_outsideMap (h : List (Σ l, twoFam U' Y l)) : lastOuter (h.map (outsideMap f)) = (lastOuter h).map e := by induction h using List.reverseRecOn with | nil => rfl @@ -115,7 +115,7 @@ theorem lastOuter_outsideMap (h : List (Σ l, twoFam U' Y l)) : · rfl include hf hg in -theorem IsResponsiveDDC.relabelOutside {b : ℕ} (hα : IsResponsiveDDC b α) : +lemma IsResponsiveDDC.relabelOutside {b : ℕ} (hα : IsResponsiveDDC b α) : IsResponsiveDDC b (relabel α (outsideMap f) (outsideMap g)) := by refine ⟨⟨?_, ?_⟩, fun h z hd => ?_, fun h hd => ?_, fun h ha hn => ?_, fun h y o hy hl => ?_⟩ · simpa only [SilentAtEmpty, relabel, List.map_nil, Part.map_Dom] using hα.dds.1 @@ -141,7 +141,7 @@ theorem IsResponsiveDDC.relabelOutside {b : ℕ} (hα : IsResponsiveDDC b α) : · cases hl include hf hg in -theorem canon_outsideMap : +lemma canon_outsideMap : canon (relabel α (outsideMap f) (outsideMap g)) = relabel (canon α) (outsideMap f) (outsideMap g) := by funext h @@ -155,10 +155,10 @@ noncomputable def renameConverter : InsideOutsideSystem O' O U' V' U V := relabel (idConverter O U V) (outsideMap f) (outsideMap g) include hf hg in -theorem renameConverter_isResponsiveDDC : IsResponsiveDDC 1 (renameConverter f g) := +lemma renameConverter_isResponsiveDDC : IsResponsiveDDC 1 (renameConverter f g) := IsResponsiveDDC.relabelOutside e f g hf hg _ (idConverter_isResponsiveDDC ..) -theorem serialM_relabel_forwardAll (hα : SilentAtEmpty α) : +lemma serialM_relabel_forwardAll (hα : SilentAtEmpty α) : serialM (relabel (forwardAll O U V) (outsideMap f) (outsideMap g)) α = relabel α (outsideMap f) (outsideMap g) := by unfold serialM @@ -174,7 +174,7 @@ theorem serialM_relabel_forwardAll (hα : SilentAtEmpty α) : include hf hg in /-- A renaming converter is precisely the relabeled history function. -/ -theorem trim_renameConverter_serialM {b : ℕ} (hα : IsResponsiveDDC b α) : +lemma trim_renameConverter_serialM {b : ℕ} (hα : IsResponsiveDDC b α) : trim (serialM (renameConverter f g) α) = relabel α (outsideMap f) (outsideMap g) := by apply ((renameConverter_isResponsiveDDC e f g hf hg).comp hα).eq_of_replies_imp (hα.relabelOutside e f g hf hg α) @@ -189,7 +189,7 @@ theorem trim_renameConverter_serialM {b : ℕ} (hα : IsResponsiveDDC b α) : change Replies (serialM (relabel (forwardAll O U V) (outsideMap f) (outsideMap g)) α) xs ys at hr' rwa [serialM_relabel_forwardAll f g α hα.dds.1] at hr' -theorem apply_relabel_forwardAll {R : InterfaceSystem O U V} (hR : SilentAtEmpty R) : +lemma apply_relabel_forwardAll {R : InterfaceSystem O U V} (hR : SilentAtEmpty R) : apply (relabel (forwardAll O U V) (outsideMap f) (outsideMap g)) R = relabel R f g := by rw [apply_eq, pair_relabel_left, interconnect_relabel, pair_swap, interconnect_relabel] apply interconnect_forwarder hR forwardAll_heterogeneous @@ -200,7 +200,7 @@ theorem apply_relabel_forwardAll {R : InterfaceSystem O U V} (hR : SilentAtEmpty exact Or.inr ⟨_, rfl, rfl⟩ include hf hg in -theorem trim_apply_renameConverter {R : InterfaceSystem O U V} (hR : IsDDS R) (hr : RepliesAtQueriedInterface R) : +lemma trim_apply_renameConverter {R : InterfaceSystem O U V} (hR : IsDDS R) (hr : RepliesAtQueriedInterface R) : trim (apply (renameConverter f g) R) = relabel R f g := by have he := canon_outsideMap e f g hf hg (forwardAll O U V) change canon (relabel (forwardAll O U V) (outsideMap f) (outsideMap g)) = renameConverter f g at he @@ -209,7 +209,7 @@ theorem trim_apply_renameConverter {R : InterfaceSystem O U V} (hR : IsDDS R) (h include hf hg in /-- Renaming transports the exact admitted domain; it does not change its replies. -/ -theorem renameConverter_mapsDomain (E : List (Σ o, U o) → Prop) +lemma renameConverter_mapsDomain (E : List (Σ o, U o) → Prop) (F : List (Σ o, U' o) → Prop) (hd : ∀ h, E (h.map f) ↔ F h) : MapsDomain E F (renameConverter f g) := by intro R hR hr hE @@ -221,24 +221,24 @@ theorem renameConverter_mapsDomain (E : List (Σ o, U o) → Prop) · intro h exact (Part.map_Dom _ _).to_iff.trans ((hE _).trans (hd h)) -theorem outsideMap_id : +lemma outsideMap_id : outsideMap (Y := Y) (id : (Σ o, U o) → (Σ o, U o)) = id := by funext z rcases z with ⟨⟨(_ | ⟨⟨⟩⟩), i⟩, z⟩ <;> rfl -theorem outsideMap_comp {O'' : Type} {U'' : O'' → Type} +lemma outsideMap_comp {O'' : Type} {U'' : O'' → Type} (f' : (Σ o, U'' o) → (Σ o, U' o)) : outsideMap (Y := Y) f ∘ outsideMap f' = outsideMap (f ∘ f') := by funext z rcases z with ⟨⟨(_ | ⟨⟨⟩⟩), i⟩, z⟩ <;> rfl -theorem renameConverter_id : +lemma renameConverter_id : renameConverter (id : (Σ o, U o) → (Σ o, U o)) (id : (Σ o, V o) → (Σ o, V o)) = idConverter O U V := by rw [renameConverter, outsideMap_id, outsideMap_id, relabel_id] include hf hg in -theorem renameConverter_comp {O'' : Type} {U'' V'' : O'' → Type} +lemma renameConverter_comp {O'' : Type} {U'' V'' : O'' → Type} (e' : O'' ≃ O') (f' : (Σ o, U'' o) → (Σ o, U' o)) (g' : (Σ o, V' o) → (Σ o, V'' o)) (hf' : ∀ u, (f' u).1 = e' u.1) (hg' : ∀ v, (g' v).1 = e'.symm v.1) : trim (serialM (renameConverter f' g') (renameConverter f g)) = @@ -256,7 +256,7 @@ def insideMap (k : (Σ j, Y j) → (Σ j, Y' j)) : | ⟨⟨none, o⟩, u⟩ => ⟨⟨none, o⟩, u⟩ | ⟨⟨some (), j⟩, y⟩ => ⟨⟨some (), (k ⟨j, y⟩).1⟩, (k ⟨j, y⟩).2⟩ -theorem serialM_forwardAll_relabel (k : (Σ j, X j) → (Σ j, X' j)) +lemma serialM_forwardAll_relabel (k : (Σ j, X j) → (Σ j, X' j)) (l : (Σ j, Y' j) → (Σ j, Y j)) (hα : SilentAtEmpty α) : serialM α (relabel (forwardAll J' X' Y') (outsideMap k) (outsideMap l)) = relabel α (insideMap l) (insideMap k) := by diff --git a/src/RandomSystems/DDC/Serial.lean b/src/RandomSystems/DDC/Serial.lean index f4c514f..0e287bb 100644 --- a/src/RandomSystems/DDC/Serial.lean +++ b/src/RandomSystems/DDC/Serial.lean @@ -57,7 +57,7 @@ noncomputable def serialM (β : InsideOutsideSystem O M U V Xm Ym) (α : InsideO interconnect (pair β α) serialRouteM serialInjM /-- Every internal cycle of `β ⊙ α` passes through `β`, continuing only after a query of `β`. -/ -theorem cyclesThrough_serial : +lemma cyclesThrough_serial : CyclesThrough (IsInside (F := twoFam V Xm)) (serialRouteM (U := U) (Ym := Ym) (Xi := Xi) (Yi := Yi)) := by refine ⟨?_, ?_, ?_⟩ @@ -71,11 +71,11 @@ theorem cyclesThrough_serial : · exact Or.inr ⟨_, rfl⟩ · exact Or.inl ⟨_, rfl⟩ -theorem IsDDC.converges_serial {b : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} (hβ : IsDDC b β) +lemma IsDDC.converges_serial {b : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} (hβ : IsDDC b β) (α : InsideOutsideSystem M J Xm Ym Xi Yi) : Converges (pair β α) serialRouteM serialInjM := converges_pair cyclesThrough_serial hβ.bound -theorem IsResponsiveDDC.converges_serial {b : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} (hβ : IsResponsiveDDC b β) +lemma IsResponsiveDDC.converges_serial {b : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} (hβ : IsResponsiveDDC b β) (α : InsideOutsideSystem M J Xm Ym Xi Yi) : Converges (pair β α) serialRouteM serialInjM := hβ.isDDC.converges_serial α @@ -88,7 +88,7 @@ variable {O L M J : Type} {U V : O → Type} {XL YL : L → Type} /-- Both bracketings connect the same three component histories. Flattening their existing connections leaves identical routing and exposed inputs. -/ -theorem IsDDC.serialM_assoc {bγ bβ : ℕ} {γ : InsideOutsideSystem O L U V XL YL} +lemma IsDDC.serialM_assoc {bγ bβ : ℕ} {γ : InsideOutsideSystem O L U V XL YL} {β : InsideOutsideSystem L M XL YL XM YM} (α : InsideOutsideSystem M J XM YM X Y) (hγ : IsDDC bγ γ) (hβ : IsDDC bβ β) : serialM (serialM γ β) α = serialM γ (serialM β α) := by @@ -105,7 +105,7 @@ theorem IsDDC.serialM_assoc {bγ bβ : ℕ} {γ : InsideOutsideSystem O L U V XL · funext x rcases x with ⟨⟨_ | ⟨⟨⟩⟩, i⟩, x⟩ <;> rfl -theorem serialM_assoc {bγ bβ : ℕ} {γ : InsideOutsideSystem O L U V XL YL} +lemma serialM_assoc {bγ bβ : ℕ} {γ : InsideOutsideSystem O L U V XL YL} {β : InsideOutsideSystem L M XL YL XM YM} (α : InsideOutsideSystem M J XM YM X Y) (hγ : IsResponsiveDDC bγ γ) (hβ : IsResponsiveDDC bβ β) : serialM (serialM γ β) α = serialM γ (serialM β α) := @@ -155,7 +155,7 @@ def SerialPostM (β : InsideOutsideSystem O M U V Xm Ym) (α : InsideOutsideSyst Waits β (restrict none G) m o ∧ 1 ≤ insideRun β (restrict none G) ∧ c + 1 ≤ bα * (insideRun β (restrict none G) - 1) + insideRun α (restrict (some ()) G)) -theorem insideRun_snoc_of_mem {O J : Type} {U V : O → Type} {Xi Yi : J → Type} +lemma insideRun_snoc_of_mem {O J : Type} {U V : O → Type} {Xi Yi : J → Type} {γ : InsideOutsideSystem O J U V Xi Yi} {h z} {y : Σ l, twoFam V Xi l} (hy : y ∈ γ (h ++ [z])) : insideRun γ (h ++ [z]) = if IsInside y then insideRun γ h + 1 else 0 := by rw [insideRun, run_snoc] @@ -165,14 +165,14 @@ theorem insideRun_snoc_of_mem {O J : Type} {U V : O → Type} {Xi Yi : J → Typ rintro ⟨y', hy', hi'⟩ exact hi (Part.mem_unique hy hy' ▸ hi') -theorem insideRun_le_of_admissible {O J : Type} {U V : O → Type} {Xi Yi : J → Type} +lemma insideRun_le_of_admissible {O J : Type} {U V : O → Type} {Xi Yi : J → Type} {γ : InsideOutsideSystem O J U V Xi Yi} {b : ℕ} (hγ : IsDDC b γ) {h z} (ha : Admissible γ (h ++ [z])) : insideRun γ h ≤ b := by rcases eq_or_ne h [] with rfl | hne · simp [insideRun] · exact hγ.bound _ ((admissible_snoc.mp ha).2.1 hne) -theorem serialM_exchange_partial (hβ : IsDDC bβ β) (hα : IsDDC bα α) {G o' G'} +lemma serialM_exchange_partial (hβ : IsDDC bβ β) (hα : IsDDC bα α) {G o' G'} (l : Exchange (pair β α) serialRouteM G o' G') : ∀ o c, SerialAtB β α bα o c G ∨ SerialAtA β α bα o c G → (o' = none ∧ ¬ (pair β α G').Dom ∧ @@ -276,14 +276,14 @@ section SerialClosure variable {O M J : Type} {U V : O → Type} {Xm Ym : M → Type} {Xi Yi : J → Type} {β : InsideOutsideSystem O M U V Xm Ym} {α : InsideOutsideSystem M J Xm Ym Xi Yi} {bβ bα : ℕ} -theorem exchange_silent_of_not_dom {X Y B : Type} {s : System X Y} {route : Y → B ⊕ X} {G o G'} +lemma exchange_silent_of_not_dom {X Y B : Type} {s : System X Y} {route : Y → B ⊕ X} {G o G'} (l : Exchange s route G o G') (hd : ¬ (s G).Dom) : o = none := by cases l with | silent => rfl | out _ y _ hy => exact absurd (Part.dom_iff_mem.mpr ⟨y, hy⟩) hd | feed _ y _ _ _ hy => exact absurd (Part.dom_iff_mem.mpr ⟨y, hy⟩) hd -theorem run_trim {X Y : Type} (P : Y → Prop) (s : System X Y) {h : List X} (hr : Reach s h) : +lemma run_trim {X Y : Type} (P : Y → Prop) (s : System X Y) {h : List X} (hr : Reach s h) : run P (trim s) h = run P s h := by induction h using List.reverseRecOn with | nil => rfl @@ -305,7 +305,7 @@ def SerialState (u : List (Σ l : Two O J, twoFam U Yi l)) (o : Option (Σ l : T insideRun (serialM β α) u ≤ bα * (insideRun β (restrict none H) - 1) + insideRun α (restrict (some ()) H))) -theorem serialM_next_partial (hβ : IsDDC bβ β) (hα : IsDDC bα α) {u o H} +lemma serialM_next_partial (hβ : IsDDC bβ β) (hα : IsDDC bα α) {u o H} (r : Induces (pair β α) serialRouteM serialInjM u o H) (hs : SerialState β α bα u o H) (a : Σ l : Two O J, twoFam U Yi l) : (admitAfter (o.map (·.1)) a.1 → @@ -432,7 +432,7 @@ theorem serialM_next_partial (hβ : IsDDC bβ β) (hα : IsDDC bα α) {u o H} exact absurd this (by simp [admitAfter, e]) /-- The responsive case follows by excluding a stopped component. -/ -theorem serialM_next (hβ : IsResponsiveDDC bβ β) (hα : IsResponsiveDDC bα α) {u o H} +lemma serialM_next (hβ : IsResponsiveDDC bβ β) (hα : IsResponsiveDDC bα α) {u o H} (r : Induces (pair β α) serialRouteM serialInjM u o H) (hs : SerialState β α bα u o H) (a : Σ l : Two O J, twoFam U Yi l) : (admitAfter (o.map (·.1)) a.1 → ∃ w H', Induces (pair β α) serialRouteM serialInjM (u ++ [a]) @@ -446,7 +446,7 @@ theorem serialM_next (hβ : IsResponsiveDDC bβ β) (hα : IsResponsiveDDC bα · exact (hf.elim (fun h => h hβ.responsive) (fun h => h hα.responsive)).elim · exact hr -theorem replyLabel_serialM {u o H} (r : Induces (pair β α) serialRouteM serialInjM u o H) : +lemma replyLabel_serialM {u o H} (r : Induces (pair β α) serialRouteM serialInjM u o H) : replyLabel (serialM β α) u = o.map (·.1) := by rcases o with _ | w · have hd : ¬ (serialM β α u).Dom := by rw [serialM]; exact not_dom_of_induces_none r @@ -454,7 +454,7 @@ theorem replyLabel_serialM {u o H} (r : Induces (pair β α) serialRouteM serial · have hw : w ∈ serialM β α u := by rw [serialM]; exact mem_of_induces_some r simp [replyLabel_of_mem _ hw] -theorem serialM_reach_partial (hβ : IsDDC bβ β) (hα : IsDDC bα α) : +lemma serialM_reach_partial (hβ : IsDDC bβ β) (hα : IsDDC bα α) : ∀ u, Reach (serialM β α) u → ∃ o H, Induces (pair β α) serialRouteM serialInjM u o H ∧ SerialState β α bα u o H ∧ ∀ u' a w, u = u' ++ [a] → o = some w → ∀ o', w.1 = ⟨none, o'⟩ → lastOuter u = some o' := by @@ -480,17 +480,17 @@ theorem serialM_reach_partial (hβ : IsDDC bβ β) (hα : IsDDC bα α) : exact hlast o' ho · exact absurd (hnext.2 had _ _ r') (by simp) -theorem serialM_reach (hβ : IsResponsiveDDC bβ β) (hα : IsResponsiveDDC bα α) : +lemma serialM_reach (hβ : IsResponsiveDDC bβ β) (hα : IsResponsiveDDC bα α) : ∀ u, Reach (serialM β α) u → ∃ o H, Induces (pair β α) serialRouteM serialInjM u o H ∧ SerialState β α bα u o H ∧ ∀ u' a w, u = u' ++ [a] → o = some w → ∀ o', w.1 = ⟨none, o'⟩ → lastOuter u = some o' := serialM_reach_partial hβ.isDDC hα.isDDC -theorem reach_of_trim {X Y : Type} {s : System X Y} {h : List X} (hd : (trim s h).Dom) : Reach s h := by +lemma reach_of_trim {X Y : Type} {s : System X Y} {h : List X} (hd : (trim s h).Dom) : Reach s h := by by_contra hr simp [trim, hr] at hd -theorem serialM_reach_of_admissible (hβ : IsResponsiveDDC bβ β) (hα : IsResponsiveDDC bα α) : +lemma serialM_reach_of_admissible (hβ : IsResponsiveDDC bβ β) (hα : IsResponsiveDDC bα α) : ∀ h, Admissible (trim (serialM β α)) h → Reach (serialM β α) h := by intro h induction h using List.reverseRecOn with @@ -579,7 +579,7 @@ theorem IsDDC.comp (hβ : IsDDC bβ β) (hα : IsDDC bα α) : · obtain rfl := hwu w rfl exact hlast h' a w rfl rfl o' ho' -theorem IsResponsiveDDC.comp (hβ : IsResponsiveDDC bβ β) (hα : IsResponsiveDDC bα α) : +lemma IsResponsiveDDC.comp (hβ : IsResponsiveDDC bβ β) (hα : IsResponsiveDDC bα α) : IsResponsiveDDC (bα * bβ) (trim (serialM β α)) := by apply isResponsiveDDC_iff.mpr refine ⟨hβ.isDDC.comp hα.isDDC, fun h ha hne => ?_⟩ @@ -599,11 +599,11 @@ variable {I O M J : Type} {X Y : I → Type} {U V : O → Type} {Xm Ym : M → T abbrev outerOfAlong : M → Free (alongSet (O := M) ι) := fun m => ⟨⟨none, ⟨none, m⟩⟩, outside_not_mem_alongSet ι m⟩ -theorem outerOfAlong_injective : Function.Injective (outerOfAlong (J := J) (M := M) ι) := by +lemma outerOfAlong_injective : Function.Injective (outerOfAlong (J := J) (M := M) ι) := by intro a b h simpa [outerOfAlong] using congrArg Subtype.val h -theorem free_not_mem_outerOfAlong {i : I} (h : (⟨some (), i⟩ : Two (Two M J) I) ∉ alongSet ι) : +lemma free_not_mem_outerOfAlong {i : I} (h : (⟨some (), i⟩ : Two (Two M J) I) ∉ alongSet ι) : (⟨some (), ⟨⟨some (), i⟩, h⟩⟩ : Two (Two O M) (Free (alongSet (O := M) ι))) ∉ alongSet (O := O) (outerOfAlong (M := M) ι) := by rintro ⟨m, hm⟩ @@ -631,7 +631,7 @@ def serialAppOut : (Σ l : Free (alongSet (O := O) (outerOfAlong (M := M) ι)), variable {ι} -theorem attachAlong_serialM (hι : Function.Injective ι) (β : InsideOutsideSystem O M U V Xm Ym) +lemma attachAlong_serialM (hι : Function.Injective ι) (β : InsideOutsideSystem O M U V Xm Ym) (α : InsideOutsideSystem M J Xm Ym (X ∘ ι) (Y ∘ ι)) (R : InterfaceSystem I X Y) (hβα : Converges (pair β α) serialRouteM serialInjM) (hαR : Converges (pair α R) (alongRoute ι) (alongInj ι)) : @@ -676,15 +676,15 @@ end SerialLaw section SerialComp -theorem EqOnReachable.rfl' {X Y : Type} (s : System X Y) : s ≈ₛ s := ⟨fun _ => Iff.rfl, fun _ _ _ => rfl⟩ +lemma EqOnReachable.rfl' {X Y : Type} (s : System X Y) : s ≈ₛ s := ⟨fun _ => Iff.rfl, fun _ _ _ => rfl⟩ -theorem EqOnReachable.pair_left {A₁ B₁ A₂ B₂ : Type} {a a' : System A₁ B₁} (ha : a ≈ₛ a') (b : System A₂ B₂) : +lemma EqOnReachable.pair_left {A₁ B₁ A₂ B₂ : Type} {a a' : System A₁ B₁} (ha : a ≈ₛ a') (b : System A₂ B₂) : pair a b ≈ₛ pair a' b := EqOnReachable.parAll fun o => by cases o with | none => exact ha | some _ => exact EqOnReachable.rfl' b -theorem EqOnReachable.serialM {O M J : Type} {U V : O → Type} {Xm Ym : M → Type} +lemma EqOnReachable.serialM {O M J : Type} {U V : O → Type} {Xm Ym : M → Type} {X Y : J → Type} {β β' : InsideOutsideSystem O M U V Xm Ym} {α α' : InsideOutsideSystem M J Xm Ym X Y} (hβ : β ≈ₛ β') (hα : α ≈ₛ α') : serialM β α ≈ₛ serialM β' α' := by apply EqOnReachable.interconnect @@ -694,7 +694,7 @@ theorem EqOnReachable.serialM {O M J : Type} {U V : O → Type} {Xm Ym : M → T /-- Associativity also holds after restricting each intermediate converter to its reachable histories. -/ -theorem IsDDC.trim_serialM_assoc {O L M J : Type} {U V : O → Type} {XL YL : L → Type} +lemma IsDDC.trim_serialM_assoc {O L M J : Type} {U V : O → Type} {XL YL : L → Type} {XM YM : M → Type} {X Y : J → Type} {bγ bβ : ℕ} {γ : InsideOutsideSystem O L U V XL YL} {β : InsideOutsideSystem L M XL YL XM YM} (α : InsideOutsideSystem M J XM YM X Y) (hγ : IsDDC bγ γ) (hβ : IsDDC bβ β) : @@ -704,7 +704,7 @@ theorem IsDDC.trim_serialM_assoc {O L M J : Type} {U V : O → Type} {XL YL : L rw [IsDDC.serialM_assoc α hγ hβ] at hl exact (hl.trans hr.symm).trim_eq (by simp [SilentAtEmpty, serialM]) (by simp [SilentAtEmpty, serialM]) -theorem trim_serialM_assoc {O L M J : Type} {U V : O → Type} {XL YL : L → Type} +lemma trim_serialM_assoc {O L M J : Type} {U V : O → Type} {XL YL : L → Type} {XM YM : M → Type} {X Y : J → Type} {bγ bβ : ℕ} {γ : InsideOutsideSystem O L U V XL YL} {β : InsideOutsideSystem L M XL YL XM YM} (α : InsideOutsideSystem M J XM YM X Y) (hγ : IsResponsiveDDC bγ γ) (hβ : IsResponsiveDDC bβ β) : @@ -722,7 +722,7 @@ noncomputable def comp {O M J : Type} {U V : O → Type} {Xm Ym : M → Type} obtain ⟨bα, hα⟩ := α.2 exact ⟨bα * bβ, hβ.comp hα⟩⟩ -theorem comp_assoc {O L M J : Type} {U V : O → Type} {XL YL : L → Type} +lemma comp_assoc {O L M J : Type} {U V : O → Type} {XL YL : L → Type} {XM YM : M → Type} {X Y : J → Type} (γ : DDC O L U V XL YL) (β : DDC L M XL YL XM YM) (α : DDC M J XM YM X Y) : comp (comp γ β) α = comp γ (comp β α) := by @@ -735,13 +735,13 @@ end DDC variable {I O J : Type} {X Y : I → Type} {U V : O → Type} -theorem EqOnReachable.attachAlong {ι : J → I} {α α' : InsideOutsideSystem O J U V (X ∘ ι) (Y ∘ ι)} (hα : α ≈ₛ α') +lemma EqOnReachable.attachAlong {ι : J → I} {α α' : InsideOutsideSystem O J U V (X ∘ ι) (Y ∘ ι)} (hα : α ≈ₛ α') (R : InterfaceSystem I X Y) : SystemAlgebra.attachAlong ι α R ≈ₛ SystemAlgebra.attachAlong ι α' R := by unfold SystemAlgebra.attachAlong connect pairI exact EqOnReachable.interconnect (EqOnReachable.relabel (EqOnReachable.pair_left hα R) _ _) _ _ /-- A system behaviourally equal to a total system, and silent before the first input, is it. -/ -theorem eq_of_behEq_total {A B : Type} {s t : System A B} (hst : s ≈ₛ t) +lemma eq_of_behEq_total {A B : Type} {s t : System A B} (hst : s ≈ₛ t) (ht : ∀ h, (t h).Dom ↔ h ≠ []) (hs : SilentAtEmpty s) (ht₀ : SilentAtEmpty t) : s = t := by funext h rcases eq_or_ne h [] with rfl | hne @@ -750,12 +750,12 @@ theorem eq_of_behEq_total {A B : Type} {s t : System A B} (hst : s ≈ₛ t) · have hr : Reach t h := fun h' e he hne' => (ht h').mpr hne' exact hst.2 h ((hst.1 h).mpr hr) hne -theorem silentAtEmpty_attachAlong {ι : J → I} (α : InsideOutsideSystem O J U V (X ∘ ι) (Y ∘ ι)) (R : InterfaceSystem I X Y) : +lemma silentAtEmpty_attachAlong {ι : J → I} (α : InsideOutsideSystem O J U V (X ∘ ι) (Y ∘ ι)) (R : InterfaceSystem I X Y) : SilentAtEmpty (attachAlong ι α R) := by rw [attachAlong_eq] exact not_dom_of_induces_none Induces.nil -theorem TotalResource.relabel {R : InterfaceSystem I X Y} (hR : TotalResource R) +lemma TotalResource.relabel {R : InterfaceSystem I X Y} (hR : TotalResource R) {L : Type} {F G : L → Type} (f : (Σ l, F l) → Σ i, X i) (g : (Σ i, Y i) → Σ l, G l) (hfg : ∀ h a y, y ∈ R ((h ++ [a]).map f) → (g y).1 = a.1) : TotalResource (SystemAlgebra.relabel R f g) := by @@ -775,7 +775,7 @@ variable {I O M J : Type} {X Y : I → Type} {U V : O → Type} {Xm Ym : M → T /-- Serial attachment preserves behavior for arbitrary partial systems, with heterogeneous interfaces. Only the converters' internal-query bounds are needed for regrouping. -/ -theorem attachAlong_comp_behEq (hι : Function.Injective ι) (hβ : IsResponsiveDDC bβ β) +lemma attachAlong_comp_behEq (hι : Function.Injective ι) (hβ : IsResponsiveDDC bβ β) (hα : IsResponsiveDDC bα α) : attachAlong ι (trim (serialM β α)) R ≈ₛ relabel (attachAlong (outerOfAlong ι) β (attachAlong ι α R)) diff --git a/src/RandomSystems/DDC/SingleAlphabet.lean b/src/RandomSystems/DDC/SingleAlphabet.lean index 06e8aa3..a5441ad 100644 --- a/src/RandomSystems/DDC/SingleAlphabet.lean +++ b/src/RandomSystems/DDC/SingleAlphabet.lean @@ -46,7 +46,7 @@ variable {K K' K'' : Type} def relabelL (τ : K ≃ K') (R : SingleAlphabetSystem X Y K) : SingleAlphabetSystem X Y K' := relabel R (fun a => ⟨τ.symm a.1, a.2⟩) (fun b => ⟨τ b.1, b.2⟩) -@[simp] theorem relabelL_refl (R : SingleAlphabetSystem X Y K) : relabelL (Equiv.refl K) R = R := by +@[simp] lemma relabelL_refl (R : SingleAlphabetSystem X Y K) : relabelL (Equiv.refl K) R = R := by exact relabel_id R end Relabel @@ -80,7 +80,7 @@ noncomputable def attachL (ι : J → K) (α : SingleAlphabetConverter X Y O J) variable {ι : J → K} {b : ℕ} {α : SingleAlphabetConverter X Y O J} {R : SingleAlphabetSystem X Y K} -theorem IsResponsiveDDC.totalResource_attachL (hι : Function.Injective ι) (hα : IsResponsiveDDC b α) +lemma IsResponsiveDDC.totalResource_attachL (hι : Function.Injective ι) (hα : IsResponsiveDDC b α) (hR : TotalResource R) : TotalResource (attachL ι α R) := by have h := hα.totalResource_along hι hR refine ⟨fun u => ?_, fun u a y hy => ?_⟩ @@ -108,13 +108,13 @@ section Naturality variable {K K' O J : Type} -theorem not_mem_alongSet_comp {τ : K ≃ K'} {κ : J → K'} {i : K} +lemma not_mem_alongSet_comp {τ : K ≃ K'} {κ : J → K'} {i : K} (h : (⟨some (), i⟩ : Two (Two O J) K) ∉ alongSet (τ.symm ∘ κ)) : (⟨some (), τ i⟩ : Two (Two O J) K') ∉ alongSet κ := by rintro ⟨j, hj⟩ exact h ⟨j, by simp [hj]⟩ -theorem not_mem_alongSet_comp' {τ : K ≃ K'} {κ : J → K'} {i : K'} +lemma not_mem_alongSet_comp' {τ : K ≃ K'} {κ : J → K'} {i : K'} (h : (⟨some (), i⟩ : Two (Two O J) K') ∉ alongSet κ) : (⟨some (), τ.symm i⟩ : Two (Two O J) K) ∉ alongSet (τ.symm ∘ κ) := by rintro ⟨j, hj⟩ @@ -146,7 +146,7 @@ def freeEquivL (τ : K ≃ K') (κ : J → K') : /-- **Naturality of attachment**: attaching to a renamed resource is renaming the attachment. -/ -theorem attachL_relabelL (τ : K ≃ K') {κ : J → K'} (hκ : Function.Injective κ) +lemma attachL_relabelL (τ : K ≃ K') {κ : J → K'} (hκ : Function.Injective κ) (β : SingleAlphabetConverter X Y O J) (S : SingleAlphabetSystem X Y K) : attachL κ β (relabelL τ S) = relabelL (freeEquivL τ κ) (attachL (τ.symm ∘ κ) β S) := by have hκ' : Function.Injective (τ.symm ∘ κ) := τ.symm.injective.comp hκ @@ -215,7 +215,7 @@ def nestOut (ι : J → K) : (Σ l : Free (alongSet (O := O) (outerOfAlong (M := | ⟨⟨⟨some (), ⟨⟨some (), i⟩, h'⟩⟩, h⟩, y⟩ => ⟨⟨⟨some (), ⟨⟨some (), i⟩, h'⟩⟩, h⟩, y⟩ /-- Attaching `β` to the outside of `α^ι R` is the nested attachment. -/ -theorem attachL_outer (β : SingleAlphabetConverter X Y O M) (α : SingleAlphabetConverter X Y M J) (R : SingleAlphabetSystem X Y K) : +lemma attachL_outer (β : SingleAlphabetConverter X Y O M) (α : SingleAlphabetConverter X Y M J) (R : SingleAlphabetSystem X Y K) : attachL (outerOfAlong ι) β (attachL ι α R) = relabel (attachAlong (outerOfAlong ι) β (attachAlong ι α R)) (nestIn ι) (nestOut ι) := by unfold attachL attachAlong connect pairI @@ -400,7 +400,7 @@ def liftOut (hd : ∀ j, ι j ∉ Set.range κ) : | ⟨⟨⟨some (), ⟨⟨none, ⟨some (), k⟩⟩, h'⟩⟩, _⟩, _⟩ => absurd (inside_mem_alongSet κ k) h' | ⟨⟨⟨some (), ⟨⟨some (), i⟩, h'⟩⟩, h⟩, y⟩ => ⟨⟨⟨some (), ⟨⟨some (), i⟩, h'⟩⟩, h⟩, y⟩ -theorem attachL_lift (hd : ∀ j, ι j ∉ Set.range κ) (hι : Function.Injective ι) +lemma attachL_lift (hd : ∀ j, ι j ∉ Set.range κ) (hι : Function.Injective ι) (α : SingleAlphabetConverter X Y O J) (β : SingleAlphabetConverter X Y O' J') (R : SingleAlphabetSystem X Y K) : attachL (liftAlong κ ι hd) α (attachL κ β R) = relabel (attachAlong (liftAlong κ ι hd) α (attachAlong κ β R)) (liftIn hd) (liftOut hd) := by @@ -540,17 +540,17 @@ by side. -/ noncomputable def parL (R : SingleAlphabetSystem X Y K) (S : SingleAlphabetSystem X Y K') : SingleAlphabetSystem X Y (K ⊕ K') := relabel (pairI R S) parIn parOut -theorem inl_not_mem_alongSet {ι : J → K} {k : K} (h : (⟨some (), k⟩ : Two (Two O J) K) ∉ alongSet ι) : +lemma inl_not_mem_alongSet {ι : J → K} {k : K} (h : (⟨some (), k⟩ : Two (Two O J) K) ∉ alongSet ι) : (⟨some (), Sum.inl k⟩ : Two (Two O J) (K ⊕ K')) ∉ alongSet (Sum.inl ∘ ι) := by rintro ⟨j, hj⟩ exact h ⟨j, Sum.inl_injective hj⟩ -theorem inr_not_mem_alongSet {ι : J → K} (k : K') : +lemma inr_not_mem_alongSet {ι : J → K} (k : K') : (⟨some (), Sum.inr k⟩ : Two (Two O J) (K ⊕ K')) ∉ alongSet (Sum.inl ∘ ι) := by rintro ⟨j, hj⟩ cases hj -theorem not_mem_alongSet_of_inl {ι : J → K} {k : K} +lemma not_mem_alongSet_of_inl {ι : J → K} {k : K} (h : (⟨some (), Sum.inl k⟩ : Two (Two O J) (K ⊕ K')) ∉ alongSet (Sum.inl ∘ ι)) : (⟨some (), k⟩ : Two (Two O J) K) ∉ alongSet ι := by rintro ⟨j, hj⟩ @@ -632,7 +632,7 @@ variable {K : Type} /-- The dummy resource (Jost p. 17): no interfaces. -/ def dummyL : SingleAlphabetSystem X Y Empty := fun _ => Part.none -theorem restrict_none_map_parIn (h : List (Σ _ : K, X)) : +lemma restrict_none_map_parIn (h : List (Σ _ : K, X)) : restrict none ((h.map fun a => (⟨(Equiv.sumEmpty K Empty).symm a.1, a.2⟩ : Σ _ : K ⊕ Empty, X)).map (splitIn ∘ parIn)) = h := by induction h with diff --git a/src/RandomSystems/DDC/Tensor.lean b/src/RandomSystems/DDC/Tensor.lean index 0d6ac2e..c49a9ce 100644 --- a/src/RandomSystems/DDC/Tensor.lean +++ b/src/RandomSystems/DDC/Tensor.lean @@ -36,13 +36,13 @@ section Canon variable {O J : Type} {U V : O → Type} {Xi Yi : J → Type} {b : ℕ} {c : InsideOutsideSystem O J U V Xi Yi} -theorem canon_dom_iff {h} : (canon c h).Dom ↔ Admissible c h ∧ (c h).Dom := by +lemma canon_dom_iff {h} : (canon c h).Dom ↔ Admissible c h ∧ (c h).Dom := by unfold canon by_cases ha : Admissible c h · simp [ha] · simp [ha] -theorem insideRun_canon : ∀ {h}, Admissible c h → insideRun (canon c) h = insideRun c h := by +lemma insideRun_canon : ∀ {h}, Admissible c h → insideRun (canon c) h = insideRun c h := by intro h induction h using List.reverseRecOn with | nil => intro _; rfl @@ -53,7 +53,7 @@ theorem insideRun_canon : ∀ {h}, Admissible c h → insideRun (canon c) h = in /-- **A criterion for partial converters.** Restricting a system to its admissible histories gives a DDC when it is bounded and replies at the last outside label there. -/ -theorem canon_isDDC (h0 : ¬ (c []).Dom) +lemma canon_isDDC (h0 : ¬ (c []).Dom) (hB : ∀ h, Admissible c h → (c h).Dom → insideRun c h ≤ b) (hRep : ∀ h y o, Admissible c h → y ∈ c h → y.1 = ⟨none, o⟩ → lastOuter h = some o) : IsDDC b (canon c) := by @@ -82,7 +82,7 @@ theorem canon_isDDC (h0 : ¬ (c []).Dom) exact hRep h y o ha hy e /-- **A criterion for converters**: responsiveness on admissible histories in addition. -/ -theorem canon_isResponsiveDDC (h0 : ¬ (c []).Dom) +lemma canon_isResponsiveDDC (h0 : ¬ (c []).Dom) (hR : ∀ h, Admissible c h → h ≠ [] → (c h).Dom) (hB : ∀ h, Admissible c h → (c h).Dom → insideRun c h ≤ b) (hRep : ∀ h y o, Admissible c h → y ∈ c h → y.1 = ⟨none, o⟩ → lastOuter h = some o) : @@ -119,17 +119,17 @@ def renameOut (α : SingleAlphabetConverter X Y O J) : SingleAlphabetConverter X variable {e} -theorem renOut_fst (y : Σ l : Two O J, twoFam (fun _ : O => Y) (fun _ : J => X) l) : +lemma renOut_fst (y : Σ l : Two O J, twoFam (fun _ : O => Y) (fun _ : J => X) l) : (renOut e y).1 = renLab e y.1 := by rcases y with ⟨⟨_ | ⟨⟨⟩⟩, l⟩, v⟩ <;> rfl -theorem isInside_renOut (y : Σ l : Two O J, twoFam (fun _ : O => Y) (fun _ : J => X) l) : +lemma isInside_renOut (y : Σ l : Two O J, twoFam (fun _ : O => Y) (fun _ : J => X) l) : IsInside (renOut e y) ↔ IsInside y := by rcases y with ⟨⟨_ | ⟨⟨⟩⟩, l⟩, v⟩ <;> simp [IsInside, renOut] variable {α : SingleAlphabetConverter X Y O J} -theorem replyLabel_renameOut (h : List (Σ l : Two O' J, twoFam (fun _ : O' => X) (fun _ : J => Y) l)) : +lemma replyLabel_renameOut (h : List (Σ l : Two O' J, twoFam (fun _ : O' => X) (fun _ : J => Y) l)) : replyLabel (renameOut e α) h = (replyLabel α (h.map (renIn e))).map (renLab e) := by unfold replyLabel by_cases hd : (α (h.map (renIn e))).Dom @@ -140,14 +140,14 @@ theorem replyLabel_renameOut (h : List (Σ l : Two O' J, twoFam (fun _ : O' => X rw [dif_neg hd, dif_neg hd'] rfl -theorem admits_renameOut (h) (z : Σ l : Two O' J, twoFam (fun _ : O' => X) (fun _ : J => Y) l) : +lemma admits_renameOut (h) (z : Σ l : Two O' J, twoFam (fun _ : O' => X) (fun _ : J => Y) l) : Admits (renameOut e α) h z ↔ Admits α (h.map (renIn e)) (renIn e z) := by unfold Admits rw [replyLabel_renameOut] rcases replyLabel α (h.map (renIn e)) with _ | ⟨_ | ⟨⟨⟩⟩, l⟩ <;> rcases z with ⟨⟨_ | ⟨⟨⟩⟩, l'⟩, v⟩ <;> simp [admitAfter, renLab, renIn] -theorem admissible_renameOut : ∀ {h}, Admissible (renameOut e α) h ↔ Admissible α (h.map (renIn e)) := by +lemma admissible_renameOut : ∀ {h}, Admissible (renameOut e α) h ↔ Admissible α (h.map (renIn e)) := by intro h induction h using List.reverseRecOn with | nil => simp @@ -155,7 +155,7 @@ theorem admissible_renameOut : ∀ {h}, Admissible (renameOut e α) h ↔ Admiss rw [admissible_snoc, List.map_append, List.map_singleton, admissible_snoc, ih, admits_renameOut] simp [renameOut, relabel] -theorem insideRun_renameOut : ∀ h, insideRun (renameOut e α) h = insideRun α (h.map (renIn e)) := by +lemma insideRun_renameOut : ∀ h, insideRun (renameOut e α) h = insideRun α (h.map (renIn e)) := by intro h induction h using List.reverseRecOn with | nil => rfl @@ -167,7 +167,7 @@ theorem insideRun_renameOut : ∀ h, insideRun (renameOut e α) h = insideRun α exact propext ⟨fun ⟨_, ⟨y, hy, rfl⟩, hi⟩ => ⟨y, hy, (isInside_renOut y).mp hi⟩, fun ⟨y, hy, hi⟩ => ⟨_, ⟨y, hy, rfl⟩, (isInside_renOut y).mpr hi⟩⟩ -theorem lastOuter_renIn : ∀ h : List (Σ l : Two O' J, twoFam (fun _ : O' => X) (fun _ : J => Y) l), +lemma lastOuter_renIn : ∀ h : List (Σ l : Two O' J, twoFam (fun _ : O' => X) (fun _ : J => Y) l), lastOuter (h.map (renIn e)) = (lastOuter h).map e := by intro h induction h using List.reverseRecOn with @@ -177,7 +177,7 @@ theorem lastOuter_renIn : ∀ h : List (Σ l : Two O' J, twoFam (fun _ : O' => X rcases z with ⟨⟨_ | ⟨⟨⟩⟩, l⟩, v⟩ <;> simp [outerOf, renIn] /-- **Renaming preserves converters.** -/ -theorem IsResponsiveDDC.renameOut {b : ℕ} (hα : IsResponsiveDDC b α) : IsResponsiveDDC b (renameOut e α) := by +lemma IsResponsiveDDC.renameOut {b : ℕ} (hα : IsResponsiveDDC b α) : IsResponsiveDDC b (renameOut e α) := by refine ⟨⟨?_, ?_⟩, fun h z hd => ?_, fun h hd => ?_, fun h ha hne => ?_, fun h y o hy hl => ?_⟩ · simpa [SilentAtEmpty, SystemAlgebra.renameOut, relabel] using hα.dds.1 · intro l₁ l₂ hp hne hd @@ -234,7 +234,7 @@ def renFree : Free (alongSet (O := O') ι) ≃ Free (alongSet (O := O) ι) where variable {e ι} /-- **Attaching a renamed converter** is attaching the converter and renaming. -/ -theorem attachL_renameOut (α : SingleAlphabetConverter X Y O J) (R : SingleAlphabetSystem X Y K) : +lemma attachL_renameOut (α : SingleAlphabetConverter X Y O J) (R : SingleAlphabetSystem X Y K) : attachL ι (renameOut e α) R = relabelL (renFree e ι).symm (attachL ι α R) := by unfold attachL attachAlong connect pairI renameOut relabelL simp only [pair_relabel_left, interconnect_relabel, relabel_interconnect, relabel_relabel] @@ -271,7 +271,7 @@ section RunZero variable {O J : Type} {U V : O → Type} {Xi Yi : J → Type} -theorem insideRun_eq_zero_of_outer {c : InsideOutsideSystem O J U V Xi Yi} {h} {o : O} +lemma insideRun_eq_zero_of_outer {c : InsideOutsideSystem O J U V Xi Yi} {h} {o : O} (hl : replyLabel c h = some ⟨none, o⟩) : insideRun c h = 0 := by rcases List.eq_nil_or_concat h with rfl | ⟨h₀, z, rfl⟩ · rfl @@ -326,52 +326,52 @@ noncomputable abbrev hA (h : List (Σ l : Two (O ⊕ O') (J ⊕ J'), twoFam U Yi noncomputable abbrev hB (h : List (Σ l : Two (O ⊕ O') (J ⊕ J'), twoFam U Yi l)) := restrict (some ()) (h.map tIn) -theorem tOut_left_fst (y : Σ l : Two O J, twoFam (V ∘ Sum.inl) (Xi ∘ Sum.inl) l) : +lemma tOut_left_fst (y : Σ l : Two O J, twoFam (V ∘ Sum.inl) (Xi ∘ Sum.inl) l) : (tOut (V := V) (Xi := Xi) ⟨none, y⟩).1 = lLab y.1 := by rcases y with ⟨⟨_ | ⟨⟨⟩⟩, l⟩, v⟩ <;> rfl -theorem tOut_right_fst (y : Σ l : Two O' J', twoFam (V ∘ Sum.inr) (Xi ∘ Sum.inr) l) : +lemma tOut_right_fst (y : Σ l : Two O' J', twoFam (V ∘ Sum.inr) (Xi ∘ Sum.inr) l) : (tOut (V := V) (Xi := Xi) ⟨some (), y⟩).1 = rLab y.1 := by rcases y with ⟨⟨_ | ⟨⟨⟩⟩, l⟩, v⟩ <;> rfl -theorem isInside_tOut_left (y : Σ l : Two O J, twoFam (V ∘ Sum.inl) (Xi ∘ Sum.inl) l) : +lemma isInside_tOut_left (y : Σ l : Two O J, twoFam (V ∘ Sum.inl) (Xi ∘ Sum.inl) l) : IsInside (tOut (V := V) (Xi := Xi) ⟨none, y⟩) ↔ IsInside y := by rcases y with ⟨⟨_ | ⟨⟨⟩⟩, l⟩, v⟩ <;> simp [IsInside, tOut] -theorem isInside_tOut_right (y : Σ l : Two O' J', twoFam (V ∘ Sum.inr) (Xi ∘ Sum.inr) l) : +lemma isInside_tOut_right (y : Σ l : Two O' J', twoFam (V ∘ Sum.inr) (Xi ∘ Sum.inr) l) : IsInside (tOut (V := V) (Xi := Xi) ⟨some (), y⟩) ↔ IsInside y := by rcases y with ⟨⟨_ | ⟨⟨⟩⟩, l⟩, v⟩ <;> simp [IsInside, tOut] variable {h : List (Σ l : Two (O ⊕ O') (J ⊕ J'), twoFam U Yi l)} {z : Σ l : Two (O ⊕ O') (J ⊕ J'), twoFam U Yi l} -theorem tensorRaw_left {a} (hz : tIn z = ⟨none, a⟩) : +lemma tensorRaw_left {a} (hz : tIn z = ⟨none, a⟩) : tensorRaw α β (h ++ [z]) = (α (hA h ++ [a])).map (fun y => tOut ⟨none, y⟩) := by simp only [tensorRaw, relabel, List.map_append, List.map_singleton, hz, pair_left, Part.map_map] rfl -theorem tensorRaw_right {a} (hz : tIn z = ⟨some (), a⟩) : +lemma tensorRaw_right {a} (hz : tIn z = ⟨some (), a⟩) : tensorRaw α β (h ++ [z]) = (β (hB h ++ [a])).map (fun y => tOut ⟨some (), y⟩) := by simp only [tensorRaw, relabel, List.map_append, List.map_singleton, hz, pair_right, Part.map_map] rfl -theorem hA_left {a} (hz : tIn z = ⟨none, a⟩) : hA (h ++ [z]) = hA h ++ [a] := by +lemma hA_left {a} (hz : tIn z = ⟨none, a⟩) : hA (h ++ [z]) = hA h ++ [a] := by show restrict none ((h ++ [z]).map tIn) = restrict none (h.map tIn) ++ [a] rw [List.map_append, List.map_singleton, hz, restrict_none_snoc_left] -theorem hB_left {a} (hz : tIn z = ⟨none, a⟩) : hB (h ++ [z]) = hB h := by +lemma hB_left {a} (hz : tIn z = ⟨none, a⟩) : hB (h ++ [z]) = hB h := by simp only [hB, List.map_append, List.map_singleton, hz] exact restrict_some_snoc_left _ _ -theorem hA_right {a} (hz : tIn z = ⟨some (), a⟩) : hA (h ++ [z]) = hA h := by +lemma hA_right {a} (hz : tIn z = ⟨some (), a⟩) : hA (h ++ [z]) = hA h := by simp only [hA, List.map_append, List.map_singleton, hz] exact restrict_none_snoc_right _ _ -theorem hB_right {a} (hz : tIn z = ⟨some (), a⟩) : hB (h ++ [z]) = hB h ++ [a] := by +lemma hB_right {a} (hz : tIn z = ⟨some (), a⟩) : hB (h ++ [z]) = hB h ++ [a] := by show restrict (some ()) ((h ++ [z]).map tIn) = restrict (some ()) (h.map tIn) ++ [a] rw [List.map_append, List.map_singleton, hz, restrict_some_snoc_right] -theorem replyLabel_tensorRaw_left {a} (hz : tIn z = ⟨none, a⟩) : +lemma replyLabel_tensorRaw_left {a} (hz : tIn z = ⟨none, a⟩) : replyLabel (tensorRaw α β) (h ++ [z]) = (replyLabel α (hA h ++ [a])).map lLab := by unfold replyLabel rw [tensorRaw_left hz] @@ -381,7 +381,7 @@ theorem replyLabel_tensorRaw_left {a} (hz : tIn z = ⟨none, a⟩) : · rw [dif_neg hd, dif_neg (by simpa using hd)] rfl -theorem replyLabel_tensorRaw_right {a} (hz : tIn z = ⟨some (), a⟩) : +lemma replyLabel_tensorRaw_right {a} (hz : tIn z = ⟨some (), a⟩) : replyLabel (tensorRaw α β) (h ++ [z]) = (replyLabel β (hB h ++ [a])).map rLab := by unfold replyLabel rw [tensorRaw_right hz] @@ -391,7 +391,7 @@ theorem replyLabel_tensorRaw_right {a} (hz : tIn z = ⟨some (), a⟩) : · rw [dif_neg hd, dif_neg (by simpa using hd)] rfl -theorem insideRun_tensorRaw_left {a} (hz : tIn z = ⟨none, a⟩) : +lemma insideRun_tensorRaw_left {a} (hz : tIn z = ⟨none, a⟩) : insideRun (tensorRaw α β) (h ++ [z]) = if ∃ y ∈ α (hA h ++ [a]), IsInside y then insideRun (tensorRaw α β) h + 1 else 0 := by rw [insideRun, run_snoc, tensorRaw_left hz] @@ -400,7 +400,7 @@ theorem insideRun_tensorRaw_left {a} (hz : tIn z = ⟨none, a⟩) : exact propext ⟨fun ⟨_, ⟨y, hy, rfl⟩, hi⟩ => ⟨y, hy, (isInside_tOut_left y).mp hi⟩, fun ⟨y, hy, hi⟩ => ⟨_, ⟨y, hy, rfl⟩, (isInside_tOut_left y).mpr hi⟩⟩ -theorem insideRun_tensorRaw_right {a} (hz : tIn z = ⟨some (), a⟩) : +lemma insideRun_tensorRaw_right {a} (hz : tIn z = ⟨some (), a⟩) : insideRun (tensorRaw α β) (h ++ [z]) = if ∃ y ∈ β (hB h ++ [a]), IsInside y then insideRun (tensorRaw α β) h + 1 else 0 := by rw [insideRun, run_snoc, tensorRaw_right hz] @@ -409,17 +409,17 @@ theorem insideRun_tensorRaw_right {a} (hz : tIn z = ⟨some (), a⟩) : exact propext ⟨fun ⟨_, ⟨y, hy, rfl⟩, hi⟩ => ⟨y, hy, (isInside_tOut_right y).mp hi⟩, fun ⟨y, hy, hi⟩ => ⟨_, ⟨y, hy, rfl⟩, (isInside_tOut_right y).mpr hi⟩⟩ -theorem insideRun_snoc_eq {O J : Type} {U V : O → Type} {Xi Yi : J → Type} (c : InsideOutsideSystem O J U V Xi Yi) +lemma insideRun_snoc_eq {O J : Type} {U V : O → Type} {Xi Yi : J → Type} (c : InsideOutsideSystem O J U V Xi Yi) (h : List (Σ l, twoFam U Yi l)) (a : Σ l, twoFam U Yi l) : insideRun c (h ++ [a]) = if ∃ y ∈ c (h ++ [a]), IsInside y then insideRun c h + 1 else 0 := run_snoc _ _ _ _ -theorem admitAfter_outer {P Q : Type} {r : Option (Two P Q)} {l : P} +lemma admitAfter_outer {P Q : Type} {r : Option (Two P Q)} {l : P} (h : admitAfter r ⟨none, l⟩) : ∀ j, r ≠ some ⟨some (), j⟩ := by rintro j rfl simp [admitAfter] at h -theorem admitAfter_inside {P Q : Type} {r : Option (Two P Q)} {j : Q} +lemma admitAfter_inside {P Q : Type} {r : Option (Two P Q)} {j : Q} (h : admitAfter r ⟨some (), j⟩) : r = some ⟨some (), j⟩ := by rcases r with _ | ⟨_ | ⟨⟨⟩⟩, l⟩ · simp [admitAfter] at h @@ -427,13 +427,13 @@ theorem admitAfter_inside {P Q : Type} {r : Option (Two P Q)} {j : Q} · simp only [admitAfter] at h rw [h] -theorem replyLabel_nil_conv {O J : Type} {U V : O → Type} {Xi Yi : J → Type} {b : ℕ} +lemma replyLabel_nil_conv {O J : Type} {U V : O → Type} {Xi Yi : J → Type} {b : ℕ} {c : InsideOutsideSystem O J U V Xi Yi} (hc : IsDDC b c) : replyLabel c [] = none := by have h := hc.dds.1 simp only [SilentAtEmpty] at h simp [replyLabel, h] -theorem replyLabel_tensorRaw_nil : replyLabel (tensorRaw α β) [] = none := by +lemma replyLabel_tensorRaw_nil : replyLabel (tensorRaw α β) [] = none := by simp [replyLabel, tensorRaw, relabel, pair, parAll] variable (α β) in @@ -467,7 +467,7 @@ def TInv (h : List (Σ l : Two (O ⊕ O') (J ⊕ J'), twoFam U Yi l)) : variable {bα bβ : ℕ} -theorem tpostA (hα : IsDDC bα α) {a} (hz : tIn z = ⟨none, a⟩) +lemma tpostA (hα : IsDDC bα α) {a} (hz : tIn z = ⟨none, a⟩) (haA : Admissible α (hA h)) (hdA : hA h ≠ [] → (α (hA h)).Dom) (haB : Admissible β (hB h)) (hdB : hB h ≠ [] → (β (hB h)).Dom) (hadm : Admits α (hA h) a) (hidB : IdleB β (O := O) (J := J) h) @@ -495,7 +495,7 @@ theorem tpostA (hα : IsDDC bα α) {a} (hz : tIn z = ⟨none, a⟩) if_pos ⟨_, hy, rfl⟩] omega -theorem tpostB (hβ : IsDDC bβ β) {a} (hz : tIn z = ⟨some (), a⟩) +lemma tpostB (hβ : IsDDC bβ β) {a} (hz : tIn z = ⟨some (), a⟩) (haA : Admissible α (hA h)) (hdA : hA h ≠ [] → (α (hA h)).Dom) (haB : Admissible β (hB h)) (hdB : hB h ≠ [] → (β (hB h)).Dom) (hadm : Admits β (hB h) a) (hidA : IdleA α (O' := O') (J' := J') h) @@ -524,7 +524,7 @@ theorem tpostB (hβ : IsDDC bβ β) {a} (hz : tIn z = ⟨some (), a⟩) omega /-- Before an outside input, both components are idle and no inside call is open. -/ -theorem tensor_idle (hα : IsDDC bα α) (hβ : IsDDC bβ β) (inv : TInv α β h) +lemma tensor_idle (hα : IsDDC bα α) (hβ : IsDDC bβ β) (inv : TInv α β h) (hn : ∀ j, replyLabel (tensorRaw α β) h ≠ some ⟨some (), j⟩) : IdleA α (O' := O') (J' := J') h ∧ IdleB β (O := O) (J := J) h ∧ insideRun (tensorRaw α β) h = 0 := by rcases eq_or_ne h [] with rfl | hne @@ -536,7 +536,7 @@ theorem tensor_idle (hα : IsDDC bα α) (hβ : IsDDC bβ β) (inv : TInv α β · exact absurd hl (hn _) · exact absurd hl (hn _) -theorem tensor_step (hα : IsDDC bα α) (hβ : IsDDC bβ β) (inv : TInv α β h) +lemma tensor_step (hα : IsDDC bα α) (hβ : IsDDC bβ β) (inv : TInv α β h) (hadm : Admits (tensorRaw α β) h z) (hnA : ∀ a, tIn z = ⟨none, a⟩ → Admissible α (hA h ++ [a]) → (α (hA h ++ [a])).Dom) (hnB : ∀ a, tIn z = ⟨some (), a⟩ → Admissible β (hB h ++ [a]) → (β (hB h ++ [a])).Dom) : @@ -584,13 +584,13 @@ theorem tensor_step (hα : IsDDC bα α) (hβ : IsDDC bβ β) (inv : TInv α β · rw [lastOuter_snoc, lastOuter_snoc] simpa [outerOf] using hlo -theorem tInv_nil : TInv α β [] := +lemma tInv_nil : TInv α β [] := ⟨fun h => absurd rfl h, admissible_nil, fun h => (h rfl).elim, admissible_nil, fun h => (h rfl).elim, fun h => absurd rfl h⟩ /-- The invariant holds on every admissible history at which `[α, β]` is defined on all nonempty prefixes. No component need answer every legal input. -/ -theorem tensor_inv_partial (hα : IsDDC bα α) (hβ : IsDDC bβ β) : +lemma tensor_inv_partial (hα : IsDDC bα α) (hβ : IsDDC bβ β) : ∀ h, Admissible (tensorRaw α β) h → (h ≠ [] → (tensorRaw α β h).Dom) → TInv α β h := by intro h induction h using List.reverseRecOn with @@ -603,7 +603,7 @@ theorem tensor_inv_partial (hα : IsDDC bα α) (hβ : IsDDC bβ β) : · rw [tensorRaw_left e] at hd'; exact hd' · rw [tensorRaw_right e] at hd'; exact hd' -theorem tensor_inv (hα : IsResponsiveDDC bα α) (hβ : IsResponsiveDDC bβ β) : +lemma tensor_inv (hα : IsResponsiveDDC bα α) (hβ : IsResponsiveDDC bβ β) : ∀ h, Admissible (tensorRaw α β) h → TInv α β h := by intro h induction h using List.reverseRecOn with @@ -619,7 +619,7 @@ noncomputable def tensorL (α : InsideOutsideSystem O J (U ∘ Sum.inl) (V ∘ S canon (tensorRaw α β) /-- **`α ⊗ β` is a partial converter**, with bound `max b b'`. -/ -theorem IsDDC.tensorL (hα : IsDDC bα α) (hβ : IsDDC bβ β) : +lemma IsDDC.tensorL (hα : IsDDC bα α) (hβ : IsDDC bβ β) : IsDDC (max bα bβ) (SystemAlgebra.tensorL α β) := by refine canon_isDDC ?_ ?_ ?_ · simp [tensorRaw, relabel, pair, parAll] @@ -648,7 +648,7 @@ theorem IsDDC.tensorL (hα : IsDDC bα α) (hβ : IsDDC bβ β) : · rw [hl'] at hl''; simp at hl'' /-- **`α ⊗ β` is a converter**, with bound `max b b'`. -/ -theorem IsResponsiveDDC.tensorL (hα : IsResponsiveDDC bα α) (hβ : IsResponsiveDDC bβ β) : +lemma IsResponsiveDDC.tensorL (hα : IsResponsiveDDC bα α) (hβ : IsResponsiveDDC bβ β) : IsResponsiveDDC (max bα bβ) (SystemAlgebra.tensorL α β) := by refine isResponsiveDDC_iff.mpr ⟨hα.isDDC.tensorL hβ.isDDC, fun h ha hne => ?_⟩ have ha' := (admissible_canon_iff h).mp ha @@ -660,7 +660,7 @@ section TensorAttach variable {X Y O O' J J' K : Type} {ι : J ⊕ J' → K} -theorem inl_not_mem_inr (hι : Function.Injective ι) (j : J) : +lemma inl_not_mem_inr (hι : Function.Injective ι) (j : J) : (ι ∘ Sum.inl) j ∉ Set.range (ι ∘ Sum.inr) := by rintro ⟨j', e⟩ exact Sum.inr_ne_inl (hι e) @@ -705,7 +705,7 @@ def tensorEquiv : · exact absurd (inside_mem_alongSet _ l) h · rfl -theorem attachL_tensorRaw {bβ : ℕ} (α : SingleAlphabetConverter X Y O J) {β : SingleAlphabetConverter X Y O' J'} (hβ : IsResponsiveDDC bβ β) +lemma attachL_tensorRaw {bβ : ℕ} (α : SingleAlphabetConverter X Y O J) {β : SingleAlphabetConverter X Y O' J'} (hβ : IsResponsiveDDC bβ β) (R : SingleAlphabetSystem X Y K) : attachL ι (tensorRaw α β) R = relabelL (tensorEquiv hι) @@ -770,7 +770,7 @@ theorem attachL_tensorRaw {bβ : ℕ} (α : SingleAlphabetConverter X Y O J) {β · simp [connectRoute_of_mem, connectRoute_of_not_mem, inside_mem_alongSet, image_mem_alongSet, outside_not_mem_alongSet, sys_mem_alongSet_lift_iff, outside_not_mem_alongSet_lift, inside_not_mem_alongSet_lift, liftC_alongRouting_inside, liftC_alongRouting_image _ hι, liftC_alongRouting_image _ (hι.comp Sum.inr_injective), liftC_alongRouting_lift _ (hι.comp Sum.inl_injective) (inl_not_mem_inr hι), tIn, tOut, liftIn, liftOut, tensorEquiv, freeIn, freeOut, splitIn, joinOut, twoAssoc, twoAssoc', connectInj, twoMap, routeComp, routeRight, alongRoute, alongInj, Function.comp_apply] /-- **Attaching `α ⊗ β`** to a total resource is attaching `β`, then `α`. -/ -theorem attachL_tensorL {bα bβ : ℕ} {α : SingleAlphabetConverter X Y O J} {β : SingleAlphabetConverter X Y O' J'} (hα : IsResponsiveDDC bα α) +lemma attachL_tensorL {bα bβ : ℕ} {α : SingleAlphabetConverter X Y O J} {β : SingleAlphabetConverter X Y O' J'} (hα : IsResponsiveDDC bα α) (hβ : IsResponsiveDDC bβ β) {R : SingleAlphabetSystem X Y K} (hR : TotalResource R) : attachL ι (tensorL α β) R = relabelL (tensorEquiv hι) diff --git a/src/RandomSystems/Distance/Absorption.lean b/src/RandomSystems/Distance/Absorption.lean index 7333f1f..fe7fba6 100644 --- a/src/RandomSystems/Distance/Absorption.lean +++ b/src/RandomSystems/Distance/Absorption.lean @@ -42,7 +42,7 @@ def absorptionInput : (Σ p, dIn Y p) → noncomputable def absorbAll (D : DDD O U V) (α : InsideOutsideSystem O J U V X Y) : DDD J X Y := interconnect (pair D α) absorptionRoute absorptionInput -theorem cyclesThrough_absorption : +lemma cyclesThrough_absorption : CyclesThrough (fun _ => True) (absorptionRoute (U := U) (V := V) (X := X) (Y := Y)) := by refine ⟨fun _ h => (h trivial).elim, ?_, ?_⟩ · rintro ⟨_ | _ | o, v⟩ _ @@ -71,7 +71,7 @@ def absorptionCloseOutput : /-- Closing after attachment is closing after absorption. The equation is the same three-system connection with a different parenthesization. -/ -theorem close_apply (D : DDD O U V) (α : InsideOutsideSystem O J U V X Y) (R : InterfaceSystem J X Y) +lemma close_apply (D : DDD O U V) (α : InsideOutsideSystem O J U V X Y) (R : InterfaceSystem J X Y) (hD : Terminating D) {b : ℕ} (hα : IsDDC b α) : close D (apply α R) = relabel (close (absorbAll D α) R) absorptionCloseInput absorptionCloseOutput := by @@ -99,7 +99,7 @@ theorem close_apply (D : DDD O U V) (α : InsideOutsideSystem O J U V X Y) (R : · exact False.elim (hl (res_mem_closeSet i)) · exact False.elim (hl (sys_mem_closeSet l)) -theorem decision_apply (D : DDD O U V) (α : InsideOutsideSystem O J U V X Y) (R : InterfaceSystem J X Y) +lemma decision_apply (D : DDD O U V) (α : InsideOutsideSystem O J U V X Y) (R : InterfaceSystem J X Y) (hD : Terminating D) {b : ℕ} (hα : IsDDC b α) (c : Bool) : decOut c ∈ close D (apply α R) [startIn] ↔ decOut c ∈ close (absorbAll D α) R [startIn] := by @@ -141,7 +141,7 @@ def AbsorptionCount (α : InsideOutsideSystem O J U V X Y) outerCount (restrict (some ()) H) ≤ (restrict none H).length ∧ (restrict (some ()) H = [] ∨ (α (restrict (some ()) H)).Dom) -theorem absorption_exchange {G out G'} (l : Exchange (pair D α) absorptionRoute G out G') : +lemma absorption_exchange {G out G'} (l : Exchange (pair D α) absorptionRoute G out G') : ∀ y, out = some y → ((∃ H z, G = H ++ [⟨none, z⟩] ∧ Reach D (restrict none H) ∧ AbsorptionIdle α H ∧ AbsorptionCount α H) ∨ @@ -225,7 +225,7 @@ def AbsorptionHistory (D : DDD O U V) (α : InsideOutsideSystem O J U V X Y) (u = [] → H = []) ∧ AbsorptionCount α H ∧ ∀ l, replyLabel (absorbAll D α) u = some l → AbsorptionReply D α l H -theorem absorption_history_snoc (hD : IsDDD D) (hα : IsDDC b α) +lemma absorption_history_snoc (hD : IsDDD D) (hα : IsDDC b α) {u H} (hh : AbsorptionHistory D α u H) {z : Σ p, dIn Y p} (hr : Reach (absorbAll D α) (u ++ [z])) : (u = [] ↔ z.1 = .start) ∧ @@ -308,7 +308,7 @@ theorem absorption_history_snoc (hD : IsDDD D) (hα : IsDDC b α) simp only [absorptionInput, restrict_some_snoc_right, outerCount_snoc] simpa using hcnt.1 -theorem absorbAll_history (hD : IsDDD D) (hα : IsDDC b α) : +lemma absorbAll_history (hD : IsDDD D) (hα : IsDDC b α) : ∀ u, Reach (absorbAll D α) u → ∃ H, AbsorptionHistory D α u H := by intro u induction u using List.reverseRecOn with @@ -324,7 +324,7 @@ theorem absorbAll_history (hD : IsDDD D) (hα : IsDDC b α) : /-- A distinguisher with bound `n` absorbs a `b`-bounded converter with a uniform bound `(b+2)*n`; neither the resource nor the converter has a finite lifetime. -/ -theorem absorbAll_finite (hD : IsDDD D) (hα : IsDDC b α) +lemma absorbAll_finite (hD : IsDDD D) (hα : IsDDC b α) {n : ℕ} (hn : Finite n D) : Finite ((b + 2) * n) (trim (absorbAll D α)) := by intro u hd have hr : Reach (absorbAll D α) u := by @@ -349,7 +349,7 @@ theorem absorbAll_finite (hD : IsDDD D) (hα : IsDDC b α) omega /-- Absorbing a heterogeneous converter preserves the distinguisher conditions. -/ -theorem absorbAll_isDDD (hD : IsDDD D) (hα : IsDDC b α) : +lemma absorbAll_isDDD (hD : IsDDD D) (hα : IsDDC b α) : IsDDD (trim (absorbAll D α)) := by refine ⟨?_, ?_, ?_, ?_, ?_⟩ · simp [SilentAtEmpty, trim, absorbAll] diff --git a/src/RandomSystems/Distance/Coupling.lean b/src/RandomSystems/Distance/Coupling.lean index bb043a8..2d74b3b 100644 --- a/src/RandomSystems/Distance/Coupling.lean +++ b/src/RandomSystems/Distance/Coupling.lean @@ -62,7 +62,7 @@ noncomputable def tr (s : System A B) (σ : List B →. A) : ℕ → List (A × variable {s : System A B} {σ : List B →. A} /-- The queries of the transcript follow `σ`. -/ -theorem cons_tr (n : ℕ) : Cons σ (s.tr σ n) := by +lemma cons_tr (n : ℕ) : Cons σ (s.tr σ n) := by induction n with | zero => exact cons_nil | succ n ih => @@ -74,7 +74,7 @@ theorem cons_tr (n : ℕ) : Cons σ (s.tr σ n) := by all_goals exact ih /-- The system gives the replies of its transcript. -/ -theorem replies_tr (n : ℕ) : +lemma replies_tr (n : ℕ) : Replies s ((s.tr σ n).map Prod.fst) ((s.tr σ n).map Prod.snd) := by induction n with | zero => exact replies_nil s @@ -89,7 +89,7 @@ theorem replies_tr (n : ℕ) : /-- **The transcript is complete** within `n` rounds when `s` answers every query `σ` asks after it: it has `n` rounds, or the strategy has stopped. -/ -theorem good_tr {n : ℕ} +lemma good_tr {n : ℕ} (hs : ∀ x ∈ σ ((s.tr σ n).map Prod.snd), (s ((s.tr σ n).map Prod.fst ++ [x])).Dom) : Good σ n (s.tr σ n) := by -- By induction: the transcript has `n` rounds, or it ended early and `s` does not answer @@ -123,7 +123,7 @@ theorem good_tr {n : ℕ} /-- **The transcript is the only complete transcript the system replies**: when `s` answers every query `σ` asks after its transcript, a transcript of `σ` complete within `n` rounds is replied by `s` exactly when it is the transcript of `s`. -/ -theorem tr_eq_iff {n : ℕ} +lemma tr_eq_iff {n : ℕ} (hs : ∀ x ∈ σ ((s.tr σ n).map Prod.snd), (s ((s.tr σ n).map Prod.fst ++ [x])).Dom) (h : List (A × B)) : s.tr σ n = h ↔ Good σ n h ∧ Replies s (h.map Prod.fst) (h.map Prod.snd) := by @@ -210,7 +210,7 @@ that the two sampled systems give different transcripts: Both transcript laws are transformations of `J` (`sLaw_behavior_eq_fTransform`), which agree where the two transcripts agree. -/ -theorem statDist_sLaw_behavior_le_of_isCoupling {P Q : PDS A B D} (hP : P.isProbDist) +lemma statDist_sLaw_behavior_le_of_isCoupling {P Q : PDS A B D} (hP : P.isProbDist) (hQ : Q.isProbDist) {J : Distribution ({s : System A B // IsDDS s ∧ HasDomain D s} × {s : System A B // IsDDS s ∧ HasDomain D s})} diff --git a/src/RandomSystems/Distance/Decision.lean b/src/RandomSystems/Distance/Decision.lean index 7953d54..3912753 100644 --- a/src/RandomSystems/Distance/Decision.lean +++ b/src/RandomSystems/Distance/Decision.lean @@ -40,7 +40,7 @@ namespace SystemAlgebra open Classical Probability open scoped NNReal -theorem Cons.queries_eq {A B : Type} {e : List B →. A} {h : List (A × B)} +lemma Cons.queries_eq {A B : Type} {e : List B →. A} {h : List (A × B)} (hc : Cons e h) : h.map Prod.fst = qsOf e (h.map Prod.snd) := by induction h using List.reverseRecOn with | nil => rfl @@ -49,7 +49,7 @@ theorem Cons.queries_eq {A B : Type} {e : List B →. A} {h : List (A × B)} simp only [List.map_append, List.map_singleton] rw [qsOf_snoc hz, ih hc] -theorem Cons.fits {I : Type} {X Y : I → Type} +lemma Cons.fits {I : Type} {X Y : I → Type} {e : List (Σ i, Y i) →. Σ i, X i} {h : List ((Σ i, X i) × (Σ i, Y i))} (hc : Cons e h) (hl : ∀ z ∈ h, z.2.1 = z.1.1) : EFits e (h.map Prod.snd) := by @@ -61,7 +61,7 @@ theorem Cons.fits {I : Type} {X Y : I → Type} exact (ih hc (fun a ha => hl a (by simp [ha]))).snoc hz (hl z (by simp)) /-- A probe is defined along precisely the environment's valid reply paths. -/ -theorem envProbe_reach {I : Type} {X Y : I → Type} +lemma envProbe_reach {I : Type} {X Y : I → Type} {E : DDE (Σ i, X i) (Σ i, Y i)} (A : List (Σ i, X i) × List (Σ i, Y i) → Prop) {ys : List (Σ i, Y i)} (hv : EFits E.1 ys) : Reach (envProbe E A) (dHist ys) := by @@ -82,7 +82,7 @@ theorem envProbe_reach {I : Type} {X Y : I → Type} simp only [envReply] split_ifs <;> exact Part.some_dom _ -theorem envOf_trim_envProbe {I : Type} {X Y : I → Type} +lemma envOf_trim_envProbe {I : Type} {X Y : I → Type} {E : DDE (Σ i, X i) (Σ i, Y i)} {A : List (Σ i, X i) × List (Σ i, Y i) → Prop} {ys} (hv : EFits E.1 ys) : envOf (trim (envProbe E A)) ys = E.1 ys := by @@ -95,7 +95,7 @@ namespace RandomSystem variable {I : Type} {X Y : I → Type} [Fintype (Σ i, X i)] [Fintype (Σ i, Y i)] {D : Domain (Σ i, X i) (Σ i, Y i)} -theorem RepliesAtQueriedInterface.history +lemma RepliesAtQueriedInterface.history {R : RandomSystem (Σ i, X i) (Σ i, Y i) D} (hr : R.RepliesAtQueriedInterface) {h} (hm : R h ≠ 0) : ∀ z ∈ h, z.2.1 = z.1.1 := by induction h using List.reverseRecOn with @@ -110,7 +110,7 @@ theorem RepliesAtQueriedInterface.history /-- Canonicalizing the probe leaves exactly the original query strategy on all possible responding-resource transcripts. -/ -theorem cons_trim_envProbe_iff +lemma cons_trim_envProbe_iff {R : RandomSystem (Σ i, X i) (Σ i, Y i) D} (hr : R.RepliesAtQueriedInterface) (E : DDE (Σ i, X i) (Σ i, Y i)) (A : List (Σ i, X i) × List (Σ i, Y i) → Prop) @@ -124,7 +124,7 @@ theorem cons_trim_envProbe_iff exact and_congr_right fun hc => by rw [envOf_trim_envProbe (hc.fits (hr.history hp))] -theorem sLaw_trim_envProbe +lemma sLaw_trim_envProbe (R : RandomSystem (Σ i, X i) (Σ i, Y i) D) (hr : R.RepliesAtQueriedInterface) (E : DDE (Σ i, X i) (Σ i, Y i)) (A : List (Σ i, X i) × List (Σ i, Y i) → Prop) (n : ℕ) : @@ -140,7 +140,7 @@ theorem sLaw_trim_envProbe · simp only [Good, hc, hh, false_and, if_false] /-- A completed transcript leaves a query-bounded environment without a next query. -/ -theorem sLaw_complete {E : DDE (Σ i, X i) (Σ i, Y i)} {n : ℕ} (hn : QueryBounded n E) +lemma sLaw_complete {E : DDE (Σ i, X i) (Σ i, Y i)} {n : ℕ} (hn : QueryBounded n E) (R : RandomSystem (Σ i, X i) (Σ i, Y i) D) {h} (hh : h ∈ (R.sLaw E.1 n).support) : ¬ (E.1 (h.map Prod.snd)).Dom := by have hp := Finsupp.mem_support_iff.mp hh @@ -176,12 +176,12 @@ def DecisionCompatible (𝒟 : Domain (Σ i, X i) (Σ i, Y i)) (D : DDD I X Y) : variable {𝒟 : Domain (Σ i, X i) (Σ i, Y i)} -theorem DecisionCompatible.environment {D : DDD I X Y} +lemma DecisionCompatible.environment {D : DDD I X Y} (hc : 𝒟.DecisionCompatible D) (hD : IsDDD D) : 𝒟.Compatible (ddeOf hD) := fun R hR h x ht hp hx => (hc R hR h ht hp).2 x hx /-- Every completed possible transcript ends in a defined decision. -/ -theorem DecisionCompatible.producesDecision {D : DDD I X Y} +lemma DecisionCompatible.producesDecision {D : DDD I X Y} (hc : 𝒟.DecisionCompatible D) (hD : IsDDD D) {R : RandomSystem (Σ i, X i) (Σ i, Y i) 𝒟} (hR : R.RepliesAtQueriedInterface) {h} (hh : h ∈ (R.sLaw (ddeOf hD).1 hD.2.1.choose).support) : @@ -202,7 +202,7 @@ theorem DecisionCompatible.producesDecision {D : DDD I X Y} /-- An environment followed by an event test is compatible with the domain of the environment. -/ -theorem envProbe_decisionCompatible {E : DDE (Σ i, X i) (Σ i, Y i)} (hc : 𝒟.Compatible E) +lemma envProbe_decisionCompatible {E : DDE (Σ i, X i) (Σ i, Y i)} (hc : 𝒟.Compatible E) (T : List (Σ i, X i) × List (Σ i, Y i) → Prop) : 𝒟.DecisionCompatible (envProbe E T) := by intro R hR h ht hp @@ -230,7 +230,7 @@ noncomputable def transcriptDistance (R S : RandomSystem (Σ i, X i) (Σ i, Y i) ⨆ (E : DDE (Σ i, X i) (Σ i, Y i)) (n : ℕ) (_ : QueryBounded n E) (_ : 𝒟.Compatible E), ENNReal.ofReal (statDist (R.sLaw E.1 n) (S.sLaw E.1 n)) -theorem statDist_le_transcriptDistance {E : DDE (Σ i, X i) (Σ i, Y i)} {n : ℕ} +lemma statDist_le_transcriptDistance {E : DDE (Σ i, X i) (Σ i, Y i)} {n : ℕ} (hn : QueryBounded n E) (hc : 𝒟.Compatible E) (R S : RandomSystem (Σ i, X i) (Σ i, Y i) 𝒟) : ENNReal.ofReal (statDist (R.sLaw E.1 n) (S.sLaw E.1 n)) ≤ R.transcriptDistance S := le_iSup_of_le E (le_iSup_of_le n (le_iSup_of_le hn (le_iSup_of_le hc le_rfl))) @@ -238,7 +238,7 @@ theorem statDist_le_transcriptDistance {E : DDE (Σ i, X i) (Σ i, Y i)} {n : /-- **A bound on the transcript laws bounds the transcript distance**: if under every compatible query-bounded environment the statistical distance of the transcript laws is at most `b`, the transcript distance is at most `b`. -/ -theorem transcriptDistance_le {R S : RandomSystem (Σ i, X i) (Σ i, Y i) 𝒟} {b : ℝ≥0} +lemma transcriptDistance_le {R S : RandomSystem (Σ i, X i) (Σ i, Y i) 𝒟} {b : ℝ≥0} (h : ∀ (E : DDE (Σ i, X i) (Σ i, Y i)) (n : ℕ), QueryBounded n E → 𝒟.Compatible E → statDist (R.sLaw E.1 n) (S.sLaw E.1 n) ≤ b) : R.transcriptDistance S ≤ b := @@ -247,7 +247,7 @@ theorem transcriptDistance_le {R S : RandomSystem (Σ i, X i) (Σ i, Y i) 𝒟} rw [← ENNReal.ofReal_coe_nnreal] exact ENNReal.ofReal_le_ofReal (h E n hn hc) -theorem transcriptDistance_le_one {R S : RandomSystem (Σ i, X i) (Σ i, Y i) 𝒟} +lemma transcriptDistance_le_one {R S : RandomSystem (Σ i, X i) (Σ i, Y i) 𝒟} (hR : R.RepliesAtQueriedInterface) (hS : S.RepliesAtQueriedInterface) : R.transcriptDistance S ≤ 1 := by rw [← ENNReal.coe_one] @@ -266,7 +266,7 @@ noncomputable def decisionProbability (D : DDD I X Y) (hD : IsDDD D) /-- An environment followed by an event test decides `1` with exactly that event's probability on its completed transcript. -/ -theorem decisionProbability_envProbe {E : DDE (Σ i, X i) (Σ i, Y i)} {n : ℕ} +lemma decisionProbability_envProbe {E : DDE (Σ i, X i) (Σ i, Y i)} {n : ℕ} (hn : QueryBounded n E) (T : List (Σ i, X i) × List (Σ i, Y i) → Prop) {R : RandomSystem (Σ i, X i) (Σ i, Y i) 𝒟} (hR : R.RepliesAtQueriedInterface) : R.decisionProbability (envProbe E T) (envProbe_isDDD hn) = @@ -300,7 +300,7 @@ theorem decisionProbability_envProbe {E : DDE (Σ i, X i) (Σ i, Y i)} {n : ℕ} simp /-- Decision gaps of a compatible distinguisher are at most the transcript distance. -/ -theorem decisionProbability_gap_le {D : DDD I X Y} (hD : IsDDD D) +lemma decisionProbability_gap_le {D : DDD I X Y} (hD : IsDDD D) (hc : 𝒟.DecisionCompatible D) {R S : RandomSystem (Σ i, X i) (Σ i, Y i) 𝒟} (hR : R.RepliesAtQueriedInterface) (hS : S.RepliesAtQueriedInterface) : |R.decisionProbability D hD - S.decisionProbability D hD| ≤ @@ -317,7 +317,7 @@ variable {E : List (Σ i, X i) → Prop} {m : ℕ} {hE : ∀ h, E h → h.length /-- On a presentation by deterministic resources, the decision probability is the probability of deciding `1` on a sample. -/ -theorem decisionProbability_of_presents (D : DDD I X Y) (hD : IsDDD D) +lemma decisionProbability_of_presents (D : DDD I X Y) (hD : IsDDD D) (P : Distribution.ProbDist {s : InterfaceSystem I X Y // IsDDS s ∧ SystemAlgebra.RepliesAtQueriedInterface s ∧ ∀ h, (s h).Dom ↔ E h}) {R : RandomSystem (Σ i, X i) (Σ i, Y i) (Domain.ofInputs E m hE)} @@ -366,7 +366,7 @@ variable {E : List (Σ i, X i) → Prop} {m : ℕ} {hE : ∀ h, E h → h.length /-- Compatibility with a domain of input histories is checked on its deterministic resources: the distinguisher decides on each of them. -/ -theorem decisionCompatible_iff_deterministic +lemma decisionCompatible_iff_deterministic (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) {D : DDD I X Y} (hD : IsDDD D) : (Domain.ofInputs E m hE : Domain (Σ i, X i) (Σ i, Y i)).DecisionCompatible D ↔ ∀ s : InterfaceSystem I X Y, IsDDS s → SystemAlgebra.RepliesAtQueriedInterface s → diff --git a/src/RandomSystems/Distance/Distinguisher.lean b/src/RandomSystems/Distance/Distinguisher.lean index 07e819b..738f553 100644 --- a/src/RandomSystems/Distance/Distinguisher.lean +++ b/src/RandomSystems/Distance/Distinguisher.lean @@ -57,7 +57,7 @@ variable {O J : Type} [Fintype O] [Fintype J] {U V : O → Type} {X Y : J → Ty /-- Absorbing a DDC from `E` to `F` into a distinguisher compatible with `F` gives a distinguisher compatible with `E`. -/ -theorem Domain.DecisionCompatible.absorbAll +lemma Domain.DecisionCompatible.absorbAll (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) (hF' : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] → F h → F p) {D : DDD O U V} @@ -83,7 +83,7 @@ theorem Domain.DecisionCompatible.absorbAll /-- **Attaching a PDC averages the absorbed decisions** over a presentation of the PDC by DDCs. -/ -theorem RandomSystem.decisionProbability_attach +lemma RandomSystem.decisionProbability_attach (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) (hF' : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] → F h → F p) (D : DDD O U V) (hD : IsDDD D) (α : PDCBehavior O J U V X Y E m hE F n hF) {b : ℕ} @@ -138,12 +138,12 @@ namespace Domain.Distinguisher variable {𝒟 : Domain (Σ i, X i) (Σ i, Y i)} (P : 𝒟.Distinguisher) (R S T : RandomSystem (Σ i, X i) (Σ i, Y i) 𝒟) -@[simp] theorem advantage_self : P.advantage R R = 0 := by simp [advantage] +@[simp] lemma advantage_self : P.advantage R R = 0 := by simp [advantage] -theorem advantage_symm : P.advantage R S = P.advantage S R := by +lemma advantage_symm : P.advantage R S = P.advantage S R := by rw [advantage, advantage, abs_sub_comm] -theorem advantage_triangle : P.advantage R T ≤ P.advantage R S + P.advantage S T := by +lemma advantage_triangle : P.advantage R T ≤ P.advantage R S + P.advantage S T := by rw [advantage, advantage, advantage, ← ENNReal.ofReal_add (abs_nonneg _) (abs_nonneg _)] exact ENNReal.ofReal_le_ofReal (abs_sub_le _ _ _) @@ -181,7 +181,7 @@ theorem RandomSystem.transcriptDistance_eq_iSup {𝒟 : Domain (Σ i, X i) (Σ i /-- **A bound on every advantage bounds the transcript distance**: if every probabilistic distinguisher's advantage is at most `b`, the transcript distance is at most `b`. -/ -theorem RandomSystem.transcriptDistance_le_of_advantage_le {𝒟 : Domain (Σ i, X i) (Σ i, Y i)} +lemma RandomSystem.transcriptDistance_le_of_advantage_le {𝒟 : Domain (Σ i, X i) (Σ i, Y i)} {R S : RandomSystem (Σ i, X i) (Σ i, Y i) 𝒟} (hR : R.RepliesAtQueriedInterface) (hS : S.RepliesAtQueriedInterface) {b : ℝ≥0} (h : ∀ P : 𝒟.Distinguisher, |P.probability R - P.probability S| ≤ b) : @@ -193,7 +193,7 @@ theorem RandomSystem.transcriptDistance_le_of_advantage_le {𝒟 : Domain (Σ i, exact ENNReal.ofReal_le_ofReal (h P) /-- The advantage of a probabilistic distinguisher is at most the transcript distance. -/ -theorem Domain.Distinguisher.advantage_le_transcriptDistance {𝒟 : Domain (Σ i, X i) (Σ i, Y i)} +lemma Domain.Distinguisher.advantage_le_transcriptDistance {𝒟 : Domain (Σ i, X i) (Σ i, Y i)} (P : 𝒟.Distinguisher) {R S : RandomSystem (Σ i, X i) (Σ i, Y i) 𝒟} (hR : R.RepliesAtQueriedInterface) (hS : S.RepliesAtQueriedInterface) : P.advantage R S ≤ R.transcriptDistance S := by @@ -225,17 +225,17 @@ namespace Domain.DistinguisherBehavior variable {𝒟 : Domain (Σ i, X i) (Σ i, Y i)} (d : 𝒟.DistinguisherBehavior) (R S T : {R : RandomSystem (Σ i, X i) (Σ i, Y i) 𝒟 // R.RepliesAtQueriedInterface}) -@[simp] theorem advantage_self : d.advantage R R = 0 := by simp [advantage] +@[simp] lemma advantage_self : d.advantage R R = 0 := by simp [advantage] -theorem advantage_symm : d.advantage R S = d.advantage S R := by +lemma advantage_symm : d.advantage R S = d.advantage S R := by rw [advantage, advantage, abs_sub_comm] -theorem advantage_triangle : d.advantage R T ≤ d.advantage R S + d.advantage S T := by +lemma advantage_triangle : d.advantage R T ≤ d.advantage R S + d.advantage S T := by rw [advantage, advantage, advantage, ← ENNReal.ofReal_add (abs_nonneg _) (abs_nonneg _)] exact ENNReal.ofReal_le_ofReal (abs_sub_le _ _ _) /-- The advantage of a distinguisher behavior is at most the transcript distance. -/ -theorem advantage_le_transcriptDistance : d.advantage R S ≤ R.1.transcriptDistance S.1 := by +lemma advantage_le_transcriptDistance : d.advantage R S ≤ R.1.transcriptDistance S.1 := by obtain ⟨P, hP⟩ := d.2 rw [advantage, hP, hP] exact P.advantage_le_transcriptDistance R.2 S.2 @@ -262,7 +262,7 @@ variable {O J : Type} [Fintype O] [Fintype J] {U V : O → Type} {X Y : J → Ty /-- Absorbing a PDC from `E` to `F` into a probabilistic distinguisher compatible with `F` gives a probabilistic distinguisher compatible with `E`. -/ -theorem Domain.Distinguisher.exists_absorbAll +lemma Domain.Distinguisher.exists_absorbAll (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) (hF' : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] → F h → F p) (α : PDCBehavior O J U V X Y E m hE F n hF) @@ -301,7 +301,7 @@ noncomputable def Domain.DistinguisherBehavior.absorb exact ⟨Q, fun R => (hP _).trans (hQ R.1 R.2).symm⟩⟩ /-- **Absorbing a serial composition** absorbs its PDCs in turn: `d ∘ (β ∘ α) = (d ∘ β) ∘ α`. -/ -theorem Domain.DistinguisherBehavior.absorb_comp {M : Type} [Fintype M] {Xm Ym : M → Type} +lemma Domain.DistinguisherBehavior.absorb_comp {M : Type} [Fintype M] {Xm Ym : M → Type} [∀ k, Fintype (Xm k)] [∀ k, Fintype (Ym k)] {F'' : List (Σ k, Xm k) → Prop} {n'' : ℕ} {hF'' : ∀ h, F'' h → h.length ≤ n''} (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) @@ -327,7 +327,7 @@ variable {I J : Type} [Fintype I] [Fintype J] {X₁ Y₁ : I → Type} {X₂ Y /-- Absorbing a resource with domain `F` run beside, given by a presentation `U`, into a probabilistic distinguisher compatible with the parallel domain gives a probabilistic distinguisher compatible with `E`. -/ -theorem Domain.Distinguisher.exists_absorbRight +lemma Domain.Distinguisher.exists_absorbRight (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) (hF' : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] → F h → F p) (P : (Domain.ofInputs (parallelInputs (F := Sum.rec X₁ X₂) E F) (m + n) diff --git a/src/RandomSystems/Distance/ParallelObservation.lean b/src/RandomSystems/Distance/ParallelObservation.lean index 47285f6..64071a6 100644 --- a/src/RandomSystems/Distance/ParallelObservation.lean +++ b/src/RandomSystems/Distance/ParallelObservation.lean @@ -47,13 +47,13 @@ noncomputable def pairObserver (D : DDD (I ⊕ J) (Sum.rec X₁ X₂) (Sum.rec Y DDD (Two I J) (twoFam X₁ X₂) (twoFam Y₁ Y₂) := relabel D pairObserverInput pairObserverOutput -theorem pairObserver_isDDD {D : DDD (I ⊕ J) (Sum.rec X₁ X₂) (Sum.rec Y₁ Y₂)} +lemma pairObserver_isDDD {D : DDD (I ⊕ J) (Sum.rec X₁ X₂) (Sum.rec Y₁ Y₂)} (hD : IsDDD D) : IsDDD (pairObserver D) := hD.relabel _ _ (twoSum I J) (by rintro ⟨_ | _ | ⟨_ | ⟨⟨⟩⟩, i⟩, v⟩ <;> first | exact v.elim | rfl) (by rintro ⟨_ | _ | (i | j), v⟩ <;> first | exact v.elim | rfl) -theorem close_parallel_system +lemma close_parallel_system (D : DDD (I ⊕ J) (Sum.rec X₁ X₂) (Sum.rec Y₁ Y₂)) (s : InterfaceSystem I X₁ Y₁) (t : InterfaceSystem J X₂ Y₂) : close D (relabel (pair s t) (sumAlphabet (Sum.rec X₁ X₂)).symm @@ -83,11 +83,11 @@ noncomputable def absorbRight (D : DDD (I ⊕ J) (Sum.rec X₁ X₂) (Sum.rec Y (t : InterfaceSystem J X₂ Y₂) : DDD I X₁ Y₁ := trim (partialClose (pairObserver D) t) -theorem absorbRight_isDDD {D : DDD (I ⊕ J) (Sum.rec X₁ X₂) (Sum.rec Y₁ Y₂)} +lemma absorbRight_isDDD {D : DDD (I ⊕ J) (Sum.rec X₁ X₂) (Sum.rec Y₁ Y₂)} (hD : IsDDD D) (t : InterfaceSystem J X₂ Y₂) : IsDDD (absorbRight D t) := partialClose_isDDD (pairObserver_isDDD hD) -theorem decision_parallel_system {D : DDD (I ⊕ J) (Sum.rec X₁ X₂) (Sum.rec Y₁ Y₂)} +lemma decision_parallel_system {D : DDD (I ⊕ J) (Sum.rec X₁ X₂) (Sum.rec Y₁ Y₂)} (hD : IsDDD D) (s : InterfaceSystem I X₁ Y₁) (t : InterfaceSystem J X₂ Y₂) (b : Bool) : decOut b ∈ close D (relabel (trim (pair s t)) (sumAlphabet (Sum.rec X₁ X₂)).symm (sumAlphabet (Sum.rec Y₁ Y₂))) [startIn] ↔ @@ -109,7 +109,7 @@ variable [Fintype I] [Fintype J] [∀ i, Fintype (X₁ i)] [∀ i, Fintype (Y₁ {F : List (Σ j, X₂ j) → Prop} {n : ℕ} {hF : ∀ h, F h → h.length ≤ n} /-- Absorbing a deterministic resource run beside preserves compatibility. -/ -theorem Domain.DecisionCompatible.absorbRight +lemma Domain.DecisionCompatible.absorbRight (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) (hF' : ¬ F [] ∧ ∀ {p h}, p <+: h → p ≠ [] → F h → F p) {D : DDD (I ⊕ J) (Sum.rec X₁ X₂) (Sum.rec Y₁ Y₂)} @@ -131,7 +131,7 @@ theorem Domain.DecisionCompatible.absorbRight /-- On presentations, the decision probability on the parallel composition averages the absorbing decisions over the samples of the right resource. -/ -theorem RandomSystem.decisionProbability_parallel +lemma RandomSystem.decisionProbability_parallel (D : DDD (I ⊕ J) (Sum.rec X₁ X₂) (Sum.rec Y₁ Y₂)) (hD : IsDDD D) (P : Distribution.ProbDist {s : InterfaceSystem I X₁ Y₁ // IsDDS s ∧ SystemAlgebra.RepliesAtQueriedInterface s ∧ ∀ h, (s h).Dom ↔ E h}) diff --git a/src/RandomSystems/Distance/Restriction.lean b/src/RandomSystems/Distance/Restriction.lean index 891a5a8..4de4bef 100644 --- a/src/RandomSystems/Distance/Restriction.lean +++ b/src/RandomSystems/Distance/Restriction.lean @@ -29,14 +29,14 @@ open Classical Probability variable {A B : Type} -theorem Admitted.mono {D D' : List (A × B) → A → Prop} (hD : ∀ h x, D' h x → D h x) +lemma Admitted.mono {D D' : List (A × B) → A → Prop} (hD : ∀ h x, D' h x → D h x) {h : List (A × B)} (ha : Admitted D' h) : Admitted D h := fun p z t he => hD _ _ (ha p z t he) /-- **Admission on an input domain**: a transcript is admitted exactly when it is empty or its inputs lie in the domain, for a domain without the empty history and closed under nonempty prefixes. -/ -theorem admitted_ofInputs_iff {E : List A → Prop} {bound : ℕ} {hE : ∀ h, E h → h.length ≤ bound} +lemma admitted_ofInputs_iff {E : List A → Prop} {bound : ℕ} {hE : ∀ h, E h → h.length ≤ bound} (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) (h : List (A × B)) : Admitted (Domain.ofInputs E bound hE : Domain A B) h ↔ h = [] ∨ E (h.map Prod.fst) := by induction h using List.reverseRecOn with @@ -60,11 +60,11 @@ noncomputable def restrict (R : RandomSystem A B D) (D' : Domain A B) (hD : ∀ h x, D' h x → D h x) : RandomSystem A B D' := ⟨fun h => if Admitted D' h then R h else 0, R.2.restrict hD⟩ -theorem restrict_apply (R : RandomSystem A B D) (hD : ∀ h x, D' h x → D h x) +lemma restrict_apply (R : RandomSystem A B D) (hD : ∀ h x, D' h x → D h x) (h : List (A × B)) : R.restrict D' hD h = if Admitted D' h then R h else 0 := rfl /-- **Restrictions compose.** -/ -theorem restrict_restrict (R : RandomSystem A B D) (hD : ∀ h x, D' h x → D h x) +lemma restrict_restrict (R : RandomSystem A B D) (hD : ∀ h x, D' h x → D h x) (hD' : ∀ h x, D'' h x → D' h x) : (R.restrict D' hD).restrict D'' hD' = R.restrict D'' fun h x hx => hD h x (hD' h x hx) := by ext h @@ -75,7 +75,7 @@ theorem restrict_restrict (R : RandomSystem A B D) (hD : ∀ h x, D' h x → D h /-- Along the queries of a strategy compatible with the restriction, every possible transcript of the system is admitted by the smaller domain. -/ -theorem admitted_of_compatible_restrict {R : RandomSystem A B D} {hD : ∀ h x, D' h x → D h x} +lemma admitted_of_compatible_restrict {R : RandomSystem A B D} {hD : ∀ h x, D' h x → D h x} {σ : List B →. A} (hc : (R.restrict D' hD).Compatible σ) {h : List (A × B)} (hh : Cons σ h) (hm : R h ≠ 0) : Admitted D' h := by induction h using List.reverseRecOn with @@ -88,14 +88,14 @@ theorem admitted_of_compatible_restrict {R : RandomSystem A B D} {hD : ∀ h x, rwa [restrict_apply, if_pos ha] /-- A strategy compatible with the restriction is compatible with the system. -/ -theorem Compatible.of_restrict {R : RandomSystem A B D} {hD : ∀ h x, D' h x → D h x} +lemma Compatible.of_restrict {R : RandomSystem A B D} {hD : ∀ h x, D' h x → D h x} {σ : List B →. A} (hc : (R.restrict D' hD).Compatible σ) : R.Compatible σ := by intro h x hh hm hx have ha := admitted_of_compatible_restrict hc hh hm exact hD h x (hc h x hh (by rwa [restrict_apply, if_pos ha]) hx) /-- **An environment compatible with the restriction** sees the transcript law of the system. -/ -theorem sLaw_restrict {R : RandomSystem A B D} {hD : ∀ h x, D' h x → D h x} +lemma sLaw_restrict {R : RandomSystem A B D} {hD : ∀ h x, D' h x → D h x} {σ : List B →. A} (hc : (R.restrict D' hD).Compatible σ) (n : ℕ) : (R.restrict D' hD).sLaw σ n = R.sLaw σ n := by ext h @@ -111,14 +111,14 @@ end RandomSystem variable {I : Type} [Fintype I] {X Y : I → Type} [∀ i, Fintype (X i)] [∀ i, Fintype (Y i)] {𝒟 𝒟' : Domain (Σ i, X i) (Σ i, Y i)} -theorem RandomSystem.RepliesAtQueriedInterface.restrict +lemma RandomSystem.RepliesAtQueriedInterface.restrict {R : RandomSystem (Σ i, X i) (Σ i, Y i) 𝒟} (hR : R.RepliesAtQueriedInterface) (hD : ∀ h x, 𝒟' h x → 𝒟 h x) : (R.restrict 𝒟' hD).RepliesAtQueriedInterface := by intro h x y hy rw [RandomSystem.restrict_apply, hR h x y hy, ite_self] /-- An environment compatible with a smaller domain is compatible with the larger one. -/ -theorem Domain.Compatible.of_restrict {E : DDE (Σ i, X i) (Σ i, Y i)} +lemma Domain.Compatible.of_restrict {E : DDE (Σ i, X i) (Σ i, Y i)} (hD : ∀ h x, 𝒟' h x → 𝒟 h x) (hc : 𝒟'.Compatible E) : 𝒟.Compatible E := fun _ hR => RandomSystem.Compatible.of_restrict (hc _ (hR.restrict hD)) diff --git a/src/RandomSystems/Distance/Transcript.lean b/src/RandomSystems/Distance/Transcript.lean index da0baa4..e75cc79 100644 --- a/src/RandomSystems/Distance/Transcript.lean +++ b/src/RandomSystems/Distance/Transcript.lean @@ -44,7 +44,7 @@ section Queries noncomputable def qsOf {A B : Type} (e : List B →. A) (ys : List B) : List A := (List.range ys.length).filterMap fun k => (e (ys.take k)).toOption -theorem qsOf_snoc {A B : Type} {e : List B →. A} {ys : List B} {x y} +lemma qsOf_snoc {A B : Type} {e : List B →. A} {ys : List B} {x y} (hx : x ∈ e ys) : qsOf e (ys ++ [y]) = qsOf e ys ++ [x] := by unfold qsOf rw [List.length_append, List.length_singleton, List.range_succ, List.filterMap_append] @@ -67,9 +67,9 @@ def EFits (e : List (Σ i, Yi i) →. Σ i, Xi i) (ys : List (Σ i, Yi i)) : Pro variable {e : List (Σ i, Yi i) →. Σ i, Xi i} -theorem EFits.nil : EFits e [] := fun k hk => absurd hk (by simp) +lemma EFits.nil : EFits e [] := fun k hk => absurd hk (by simp) -theorem EFits.of_snoc {ys : List (Σ i, Yi i)} {y} (hv : EFits e (ys ++ [y])) : +lemma EFits.of_snoc {ys : List (Σ i, Yi i)} {y} (hv : EFits e (ys ++ [y])) : EFits e ys ∧ ∃ x ∈ e ys, y.1 = x.1 := by refine ⟨fun k hk => ?_, ?_⟩ · obtain ⟨x, hx, hl⟩ := hv k (by simp; omega) @@ -79,7 +79,7 @@ theorem EFits.of_snoc {ys : List (Σ i, Yi i)} {y} (hv : EFits e (ys ++ [y])) : rw [List.take_left' rfl] at hx exact ⟨x, hx, by simpa using hl⟩ -theorem EFits.snoc {ys : List (Σ i, Yi i)} (hv : EFits e ys) {x y} (hx : x ∈ e ys) +lemma EFits.snoc {ys : List (Σ i, Yi i)} (hv : EFits e ys) {x y} (hx : x ∈ e ys) (hy : y.1 = x.1) : EFits e (ys ++ [y]) := by intro k hk simp only [List.length_append, List.length_singleton] at hk @@ -110,7 +110,7 @@ noncomputable def envProbe : DDD K Xi Yi variable {E A} -theorem envProbe_dHist {ys : List (Σ i, Yi i)} (hv : EFits E.1 ys) : +lemma envProbe_dHist {ys : List (Σ i, Yi i)} (hv : EFits E.1 ys) : envProbe E A (dHist ys) = envReply E A ys := by have hex : ∃ ys', ys.map envIn = ys'.map envIn ∧ EFits E.1 ys' := ⟨ys, rfl, hv⟩ simp only [envProbe, dHist, dif_pos hex] @@ -118,7 +118,7 @@ theorem envProbe_dHist {ys : List (Σ i, Yi i)} (hv : EFits E.1 ys) : (List.map_injective_iff.mpr envIn_injective (Classical.choose_spec hex).1).symm rw [e] -theorem envProbe_dom {w} (hd : (envProbe E A w).Dom) : ∃ ys, w = dHist ys ∧ EFits E.1 ys := by +lemma envProbe_dom {w} (hd : (envProbe E A w).Dom) : ∃ ys, w = dHist ys ∧ EFits E.1 ys := by match w, hd with | ⟨.start, ()⟩ :: ws, hd => simp only [envProbe] at hd @@ -130,7 +130,7 @@ theorem envProbe_dom {w} (hd : (envProbe E A w).Dom) : ∃ ys, w = dHist ys ∧ | ⟨.dec, e⟩ :: _, _ => exact e.elim | ⟨.res _, _⟩ :: _, hd => exact hd.elim -theorem envReply_of_mem {ys : List (Σ i, Yi i)} {x} (hx : x ∈ E.1 ys) : +lemma envReply_of_mem {ys : List (Σ i, Yi i)} {x} (hx : x ∈ E.1 ys) : envReply E A ys = Part.some ⟨.res x.1, x.2⟩ := by have hd : (E.1 ys).Dom := Part.dom_iff_mem.mpr ⟨x, hx⟩ unfold envReply @@ -140,7 +140,7 @@ theorem envReply_of_mem {ys : List (Σ i, Yi i)} {x} (hx : x ∈ E.1 ys) : variable {n : ℕ} -theorem envProbe_finite (hE : QueryBounded n E) : Finite (n + 1) (envProbe E A) := by +lemma envProbe_finite (hE : QueryBounded n E) : Finite (n + 1) (envProbe E A) := by intro w hd obtain ⟨ys, rfl, hv⟩ := envProbe_dom hd simp only [dHist, List.length_cons, List.length_map] @@ -152,7 +152,7 @@ theorem envProbe_finite (hE : QueryBounded n E) : Finite (n + 1) (envProbe E A) simp; omega /-- **`envProbe E A` is a DDD**, with bound `n + 1` for an environment with query bound `n`. -/ -theorem envProbe_isDDD (hE : QueryBounded n E) : IsDDD (envProbe E A) := by +lemma envProbe_isDDD (hE : QueryBounded n E) : IsDDD (envProbe E A) := by refine ⟨?_, ⟨n + 1, envProbe_finite hE⟩, ?_, ?_, ?_⟩ · simp [SilentAtEmpty, envProbe] · intro w z hr @@ -176,7 +176,7 @@ theorem envProbe_isDDD (hE : QueryBounded n E) : IsDDD (envProbe E A) := by rw [replyLabel, envProbe_dHist hv, envReply_of_mem hx] at hl simp at hl -theorem envOf_envProbe {ys : List (Σ i, Yi i)} (hv : EFits E.1 ys) : +lemma envOf_envProbe {ys : List (Σ i, Yi i)} (hv : EFits E.1 ys) : envOf (envProbe E A) ys = E.1 ys := by unfold envOf rw [envProbe_dHist hv] @@ -215,7 +215,7 @@ noncomputable def ddeOf (hD : IsDDD D) : DDE (Σ i, Xi i) (Σ i, Yi i) := exact ho⟩ /-- The environment of a distinguisher's queries is bounded by the distinguisher's bound. -/ -theorem ddeOf_bounded (hD : IsDDD D) : QueryBounded hD.2.1.choose (ddeOf hD) := by +lemma ddeOf_bounded (hD : IsDDD D) : QueryBounded hD.2.1.choose (ddeOf hD) := by intro ys hd obtain ⟨x, hx⟩ := Part.dom_iff_mem.mp hd have hx : x ∈ envOf (trim D) ys := hx @@ -228,7 +228,7 @@ theorem ddeOf_bounded (hD : IsDDD D) : QueryBounded hD.2.1.choose (ddeOf hD) := simp [dHist] at this omega -theorem finite_trim {n : ℕ} {s : System X Y} (hs : Finite n s) : Finite n (trim s) := by +lemma finite_trim {n : ℕ} {s : System X Y} (hs : Finite n s) : Finite n (trim s) := by intro h hd apply hs by_contra hn @@ -238,7 +238,7 @@ theorem finite_trim {n : ℕ} {s : System X Y} (hs : Finite n s) : Finite n (tri end OfDDD -theorem abs_mass_sub_le_statDist {S : Type} (P Q : Distribution.ProbDist S) (A : S → Prop) : +lemma abs_mass_sub_le_statDist {S : Type} (P Q : Distribution.ProbDist S) (A : S → Prop) : |P.1.mass A - Q.1.mass A| ≤ statDist P.1 Q.1 := by rw [abs_le] refine ⟨?_, Probability.mass_sub_mass_le_statDist _ _ _⟩ @@ -252,7 +252,7 @@ section Utilities /-- Closing with the reachable part of an environment decides as closing with the environment. -/ -theorem close_trim_start {I : Type} {Xf Yf : I → Type} (D : DDD I Xf Yf) (R : InterfaceSystem I Xf Yf) : +lemma close_trim_start {I : Type} {Xf Yf : I → Type} (D : DDD I Xf Yf) (R : InterfaceSystem I Xf Yf) : close (trim D) R [startIn] = close D R [startIn] := by rw [close_eq, close_eq] have hb := EqOnReachable.interconnect (EqOnReachable.pair_left (trim_behEq D) R) closeRoute closeInj @@ -266,7 +266,7 @@ theorem close_trim_start {I : Type} {Xf Yf : I → Type} (D : DDD I Xf Yf) (R : /-- **Averaging.** Under a probability distribution, a pointwise bound on a difference bounds the difference of the averages. -/ -theorem abs_average_sub_le {S : Type} (A : Distribution.ProbDist S) (f g : S → ℝ) {ε : ℝ} +lemma abs_average_sub_le {S : Type} (A : Distribution.ProbDist S) (f g : S → ℝ) {ε : ℝ} (h : ∀ a, |f a - g a| ≤ ε) : |A.1.sum (fun a w => w * f a) - A.1.sum (fun a w => w * g a)| ≤ ε := by have hw : A.1.sum (fun _ w => w) = 1 := A.2.2 @@ -295,7 +295,7 @@ def DPort.map {L L' : Type} (σ : L → L') : DPort L → DPort L' variable {L L' : Type} {F G : DPort L → Type} {F' G' : DPort L' → Type} -theorem reach_relabel_iff (D : InterfaceSystem (DPort L) F G) (f : (Σ p, F' p) → Σ p, F p) +lemma reach_relabel_iff (D : InterfaceSystem (DPort L) F G) (f : (Σ p, F' p) → Σ p, F p) (g : (Σ p, G p) → Σ p, G' p) (h : List (Σ p, F' p)) : Reach (relabel D f g) h ↔ Reach D (h.map f) := by induction h using List.reverseRecOn with @@ -304,7 +304,7 @@ theorem reach_relabel_iff (D : InterfaceSystem (DPort L) F G) (f : (Σ p, F' p) rw [reach_snoc_iff, ih, List.map_append, List.map_singleton, reach_snoc_iff] simp [relabel] -theorem replyLabel_relabel (D : InterfaceSystem (DPort L) F G) (f : (Σ p, F' p) → Σ p, F p) +lemma replyLabel_relabel (D : InterfaceSystem (DPort L) F G) (f : (Σ p, F' p) → Σ p, F p) (g : (Σ p, G p) → Σ p, G' p) (σ : L' ≃ L) (hg : ∀ y, (g y).1 = DPort.map σ.symm y.1) (h : List (Σ p, F' p)) : replyLabel (relabel D f g) h = (replyLabel D (h.map f)).map (DPort.map σ.symm) := by @@ -318,7 +318,7 @@ theorem replyLabel_relabel (D : InterfaceSystem (DPort L) F G) (f : (Σ p, F' p) rfl /-- **Renaming the labels of a distinguisher along a bijection gives a distinguisher.** -/ -theorem IsDDD.relabel {D : InterfaceSystem (DPort L) F G} (hD : IsDDD D) (f : (Σ p, F' p) → Σ p, F p) +lemma IsDDD.relabel {D : InterfaceSystem (DPort L) F G} (hD : IsDDD D) (f : (Σ p, F' p) → Σ p, F p) (g : (Σ p, G p) → Σ p, G' p) (σ : L' ≃ L) (hf : ∀ z, (f z).1 = DPort.map σ z.1) (hg : ∀ y, (g y).1 = DPort.map σ.symm y.1) : IsDDD (SystemAlgebra.relabel D f g) := by obtain ⟨hre, ⟨n, hn⟩, htr, hres, hdec⟩ := hD @@ -389,7 +389,7 @@ def decMap {I I' : Type} {Xf Yf : I → Type} {Xf' Yf' : I' → Type} : | ⟨⟨⟨none, .res i⟩, h⟩, _⟩ => absurd (res_mem_closeSet i) h | ⟨⟨⟨some (), i⟩, h⟩, _⟩ => absurd (sys_mem_closeSet i) h -theorem trigMap_eq {I I' : Type} {Xf Yf : I → Type} {Xf' Yf' : I' → Type} (z) : +lemma trigMap_eq {I I' : Type} {Xf Yf : I → Type} {Xf' Yf' : I' → Type} (z) : trigMap (Xf := Xf) (Yf := Yf) (Xf' := Xf') (Yf' := Yf') z = startIn := by rcases z with ⟨⟨⟨_ | ⟨⟨⟩⟩, l⟩, hl⟩, v⟩ · rcases l with _ | _ | i @@ -399,7 +399,7 @@ theorem trigMap_eq {I I' : Type} {Xf Yf : I → Type} {Xf' Yf' : I' → Type} (z · exact absurd (sys_mem_closeSet l) hl /-- Maps sending decisions to decisions do not change whether `1` is decided. -/ -theorem decOut_mem_map_iff {I I' : Type} {Xf Yf : I → Type} {Xf' Yf' : I' → Type} +lemma decOut_mem_map_iff {I I' : Type} {Xf Yf : I → Type} {Xf' Yf' : I' → Type} (g : (Σ l : Free (closeSet I), twoFam (dOut Xf) Yf l.1) → Σ l : Free (closeSet I'), twoFam (dOut Xf') Yf' l.1) (hg : ∀ b, g (decOut b) = decOut b) (P : Part (Σ l : Free (closeSet I), twoFam (dOut Xf) Yf l.1)) (c : Bool) : decOut c ∈ P.map g ↔ decOut c ∈ P := by diff --git a/src/RandomSystems/Distance/UntilBad.lean b/src/RandomSystems/Distance/UntilBad.lean index 634f89f..4aaa239 100644 --- a/src/RandomSystems/Distance/UntilBad.lean +++ b/src/RandomSystems/Distance/UntilBad.lean @@ -40,7 +40,7 @@ def transcriptCost (β : List (A × B) → A → ℝ) : List (A × B) → ℝ | z :: t => β [] z.1 + transcriptCost (fun p x => β (z :: p) x) t /-- One more step adds its cost. -/ -theorem transcriptCost_snoc (β : List (A × B) → A → ℝ) (h : List (A × B)) (x : A) (y : B) : +lemma transcriptCost_snoc (β : List (A × B) → A → ℝ) (h : List (A × B)) (x : A) (y : B) : transcriptCost β (h ++ [(x, y)]) = transcriptCost β h + β h x := by -- Induction on h, for every β: peel the first step off both sides. induction h generalizing β with @@ -62,7 +62,7 @@ variable {A B : Type} [Fintype A] [Fintype B] {D : Domain A B} query `x` loses at most `β h x · R h` of `g`, and every possible transcript costs at most `ε`, then the transcripts of a compatible strategy `σ` within `n` rounds that `R` makes possible carry at least `1 - ε` of `g`. This is the union bound over the steps. -/ -theorem one_sub_le_sum_tSupp {R : RandomSystem A B D} {σ : List B →. A} (hC : R.Compatible σ) +lemma one_sub_le_sum_tSupp {R : RandomSystem A B D} {σ : List B →. A} (hC : R.Compatible σ) {g : List (A × B) → ℝ} (hg : ∀ h, g h ≤ R h) (hnil : g [] = 1) {β : List (A × B) → A → ℝ} (hloss : ∀ h x, R h ≠ 0 → D h x → g h - ∑ y, g (h ++ [(x, y)]) ≤ β h x * R h) {ε : ℝ} diff --git a/src/RandomSystems/Game/DiscreteMBO.lean b/src/RandomSystems/Game/DiscreteMBO.lean index dd6c9a6..be8106e 100644 --- a/src/RandomSystems/Game/DiscreteMBO.lean +++ b/src/RandomSystems/Game/DiscreteMBO.lean @@ -71,7 +71,7 @@ noncomputable def goodProbability (G : PDG X Y D) (h : List (X × Y)) : ℝ := G.mass (fun g => Replies g.1.1.1 (h.map Prod.fst) (h.map Prod.snd) ∧ ¬ g.1.2.1 (h.map Prod.fst)) -theorem underlying_probability {G : PDG X Y D} (hG : G.isProbDist) : +lemma underlying_probability {G : PDG X Y D} (hG : G.isProbDist) : G.underlying.isProbDist := Distribution.fTransform_isProbDist _ hG end PDG @@ -82,7 +82,7 @@ variable {I : Type} {X Y : I → Type} /-- A reply with the MBO `c` is `v` exactly when the reply is `v` with its MBO forgotten and the MBO of `v` is `c`. -/ -theorem map_tagMBO_eq_some_iff {p : Part (Σ i, Y i)} {c : Bool} {v : Σ i, withMBO Y i} : +lemma map_tagMBO_eq_some_iff {p : Part (Σ i, Y i)} {c : Bool} {v : Σ i, withMBO Y i} : p.map (tagMBO c) = Part.some v ↔ p = Part.some (forgetMBO v) ∧ v.2.2 = c := by -- Read both equations `_ = Part.some _` as membership, and unfold membership in a map. rw [Part.eq_some_iff, Part.eq_some_iff, Part.mem_map_iff] @@ -119,7 +119,7 @@ noncomputable def withMBO (g : DDG (Σ i, X i) (Σ i, Y i)) : fun _ _ hp hn hd => g.1.2.2 hp hn hd⟩ /-- Forgetting the MBO gives the DDS of the game. -/ -theorem relabel_withMBO (g : DDG (Σ i, X i) (Σ i, Y i)) : +lemma relabel_withMBO (g : DDG (Σ i, X i) (Σ i, Y i)) : relabel (withMBO g).1 id forgetMBO = g.1.1 := by -- Compare the two systems at each query history `h`. funext h @@ -131,7 +131,7 @@ theorem relabel_withMBO (g : DDG (Σ i, X i) (Σ i, Y i)) : open scoped Classical in /-- The transcripts of a game with the MBO: the transcripts of its DDS, each reply with the condition on the queries so far. -/ -theorem replies_withMBO_iff (g : DDG (Σ i, X i) (Σ i, Y i)) (xs : List (Σ i, X i)) +lemma replies_withMBO_iff (g : DDG (Σ i, X i) (Σ i, Y i)) (xs : List (Σ i, X i)) (ys : List (Σ i, SystemAlgebra.withMBO Y i)) : Replies (withMBO g).1 xs ys ↔ Replies g.1.1 xs (ys.map forgetMBO) ∧ ∀ k (hk : k < ys.length), ys[k].2.2 = decide (g.2.1 (xs.take (k + 1))) := by @@ -150,7 +150,7 @@ theorem replies_withMBO_iff (g : DDG (Σ i, X i) (Σ i, Y i)) (xs : List (Σ i, exact ⟨hl, fun k hk hk' => map_tagMBO_eq_some_iff.mpr ⟨h k hk hk', ht k hk'⟩⟩ /-- Along a transcript of a game with the MBO, the MBO, once set, stays set. -/ -theorem pairwise_withMBO {g : DDG (Σ i, X i) (Σ i, Y i)} {xs : List (Σ i, X i)} +lemma pairwise_withMBO {g : DDG (Σ i, X i) (Σ i, Y i)} {xs : List (Σ i, X i)} {ys : List (Σ i, SystemAlgebra.withMBO Y i)} (hr : Replies (withMBO g).1 xs ys) : (ys.map fun y => y.2.2).Pairwise (· ≤ ·) := by -- By `replies_withMBO_iff`, the k-th MBO is the condition on x₁ … x_{k+1}. @@ -172,7 +172,7 @@ theorem pairwise_withMBO {g : DDG (Σ i, X i) (Σ i, Y i)} {xs : List (Σ i, X i open scoped Classical in /-- On a nonempty transcript, the MBO is unset throughout exactly when the condition does not hold on its queries. -/ -theorem replies_withMBO_unset_iff (g : DDG (Σ i, X i) (Σ i, Y i)) {xs : List (Σ i, X i)} +lemma replies_withMBO_unset_iff (g : DDG (Σ i, X i) (Σ i, Y i)) {xs : List (Σ i, X i)} (hxs : xs ≠ []) (ys : List (Σ i, Y i)) : Replies (withMBO g).1 xs (ys.map (tagMBO false)) ↔ Replies g.1.1 xs ys ∧ ¬ g.2.1 xs := by -- By `replies_withMBO_iff`: the replies with the MBO forgotten are replies of `g.1`, and @@ -226,7 +226,7 @@ noncomputable def withMBO (G : PDG (Σ i, X i) (Σ i, Y i) (Domain.ofInputs E m rw [map_fst_forgetMBOs] at hd exact hd.trans (by simp only [Domain.ofInputs_apply, map_fst_forgetMBOs])⟩) G -theorem withMBO_isProbDist {G : PDG (Σ i, X i) (Σ i, Y i) (Domain.ofInputs E m hE)} +lemma withMBO_isProbDist {G : PDG (Σ i, X i) (Σ i, Y i) (Domain.ofInputs E m hE)} (hG : G.isProbDist) : G.withMBO.isProbDist := Distribution.fTransform_isProbDist _ hG @@ -237,7 +237,7 @@ noncomputable def behavior (G : PDG (Σ i, X i) (Σ i, Y i) (Domain.ofInputs E m RandomSystem (Σ i, X i) (Σ i, SystemAlgebra.withMBO Y i) (Domain.ofInputs E m hE) := PDS.behavior G.withMBO (withMBO_isProbDist hG) -theorem behavior_apply (G : PDG (Σ i, X i) (Σ i, Y i) (Domain.ofInputs E m hE)) +lemma behavior_apply (G : PDG (Σ i, X i) (Σ i, Y i) (Domain.ofInputs E m hE)) (hG : G.isProbDist) (h : List ((Σ i, X i) × Σ i, SystemAlgebra.withMBO Y i)) : G.behavior hG h = G.mass fun g => Replies (DDG.withMBO g.1).1 (h.map Prod.fst) (h.map Prod.snd) := by @@ -250,7 +250,7 @@ variable {G : PDG (Σ i, X i) (Σ i, Y i) (Domain.ofInputs E m hE)} (hG : G.isPr open scoped Classical in /-- **The visible system of the game of a probabilistic discrete game** is the behavior of its visible systems. -/ -theorem visible_behavior : +lemma visible_behavior : (G.behavior hG).visible = PDS.behavior G.underlying (underlying_probability hG) := by -- Compare the two random systems transcript by transcript. apply RandomSystem.ext @@ -283,7 +283,7 @@ theorem visible_behavior : rw [sumMBO_const_mul, sumMBO_replies, DDG.relabel_withMBO, mul_boole] /-- **The game of a probabilistic discrete game is a game**: its MBO, once set, stays set. -/ -theorem monotoneMBO_behavior : (G.behavior hG).MonotoneMBO := by +lemma monotoneMBO_behavior : (G.behavior hG).MonotoneMBO := by -- Take a transcript `h` of positive probability. intro h hne -- Its probability is the mass of the games with the MBO that reply `h`. @@ -299,7 +299,7 @@ theorem monotoneMBO_behavior : (G.behavior hG).MonotoneMBO := by simpa only [List.map_map, Function.comp_def] using DDG.pairwise_withMBO hr /-- The game replies at the queried interface when its visible systems do. -/ -theorem repliesAtQueriedInterface_behavior +lemma repliesAtQueriedInterface_behavior (hU : (PDS.behavior G.underlying (underlying_probability hG)).RepliesAtQueriedInterface) : (G.behavior hG).RepliesAtQueriedInterface := -- The game replies at the queried interface when its visible system does (`of_visible`), @@ -311,7 +311,7 @@ variable (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) omit [Fintype I] [∀ i, Fintype (X i)] [∀ i, Fintype (Y i)] in include hE' in /-- On an admitted query sequence, a deterministic game with the MBO answers every query. -/ -theorem exists_transcript_withMBO +lemma exists_transcript_withMBO (g : {g : DDG (Σ i, X i) (Σ i, Y i) // HasDomain (Domain.ofInputs E m hE) g.1.1}) {xs : List (Σ i, X i)} (hxs : E xs) : ∃ ys, Transcript (DDG.withMBO g.1).1 (fixedQueries xs) xs ys := by @@ -328,7 +328,7 @@ theorem exists_transcript_withMBO include hE' in /-- **On an admitted query sequence, the MBO is unset with the probability that the condition does not hold.** -/ -theorem unsetProbability_behavior {xs : List (Σ i, X i)} (hxs : E xs) : +lemma unsetProbability_behavior {xs : List (Σ i, X i)} (hxs : E xs) : (G.behavior hG).unsetProbability xs = 1 - G.badProbability xs := by -- Plan: -- 1. With the fixed queries xs, every transcript of positive probability is complete; so @@ -431,7 +431,7 @@ include hE' in /-- **A bound on the condition bounds the set MBO**: if the condition holds with probability at most `ε` on the empty and on every admitted query sequence, the MBO stays unset with probability at least `1 - ε` on the queries of each possible transcript of a random system on the domain. -/ -theorem one_sub_le_unsetProbability_behavior +lemma one_sub_le_unsetProbability_behavior {S : RandomSystem (Σ i, X i) (Σ i, Y i) (Domain.ofInputs E m hE)} {ε : ℝ} (hbad : ∀ xs, xs = [] ∨ E xs → G.badProbability xs ≤ ε) (h : List ((Σ i, X i) × Σ i, Y i)) (hh : S h ≠ 0) : 1 - ε ≤ (G.behavior hG).unsetProbability (h.map Prod.fst) := by diff --git a/src/RandomSystems/Game/FunctionGame.lean b/src/RandomSystems/Game/FunctionGame.lean index a7887c0..e134894 100644 --- a/src/RandomSystems/Game/FunctionGame.lean +++ b/src/RandomSystems/Game/FunctionGame.lean @@ -42,19 +42,19 @@ noncomputable def ofFunction (P : Distribution K) (f : K → X → Y) (bad : K Distribution.fTransform (fun k => ⟨(DDS.ofFunction D hD (f k), bad k), HasDomain.ofInputs (DDS.ofFunction_dom D hD (f k))⟩) P -theorem ofFunction_isProbDist {P : Distribution K} (hP : P.isProbDist) +lemma ofFunction_isProbDist {P : Distribution K} (hP : P.isProbDist) (f : K → X → Y) (bad : K → MC X) : (ofFunction D hD bound hb P f bad).isProbDist := Distribution.fTransform_isProbDist _ hP /-- The visible systems are the sampled function. -/ -theorem ofFunction_underlying (P : Distribution K) (f : K → X → Y) (bad : K → MC X) : +lemma ofFunction_underlying (P : Distribution K) (f : K → X → Y) (bad : K → MC X) : (ofFunction D hD bound hb P f bad).underlying = PDS.ofFunction D hD bound hb f P := by -- Both sides push `P` forward; compose k ↦ game ↦ its DDS into one map. rw [underlying, ofFunction, Distribution.fTransform_comp] -- The composite map is the map of `PDS.ofFunction`: k ↦ the evaluator of `f k`. rfl -theorem ofFunction_badProbability (P : Distribution K) (f : K → X → Y) +lemma ofFunction_badProbability (P : Distribution K) (f : K → X → Y) (bad : K → MC X) (xs : List X) : (ofFunction D hD bound hb P f bad).badProbability xs = P.mass (fun k => (bad k).1 xs) := by -- The mass of an event under a push-forward of `P` is the `P`-mass of its preimage. @@ -125,7 +125,7 @@ namespace SystemAlgebra open Probability /-- At a single interface, a reply equality is just equality of its values. -/ -theorem single_interface_answers_iff {I X Y : Type} [Unique I] +lemma single_interface_answers_iff {I X Y : Type} [Unique I] (xs : List (Σ _ : I, X)) (answers : (Σ _ : I, X) → Σ _ : I, Y) (f : X → Y) : (∀ x ∈ xs, (⟨x.1, f x.2⟩ : Σ _ : I, Y) = answers x) ↔ ∀ x ∈ xs.map Sigma.snd, f x = (answers ⟨default, x⟩).2 := by diff --git a/src/RandomSystems/Game/MBO.lean b/src/RandomSystems/Game/MBO.lean index c81e3fa..435b3ce 100644 --- a/src/RandomSystems/Game/MBO.lean +++ b/src/RandomSystems/Game/MBO.lean @@ -78,9 +78,9 @@ def forgetMBO (y : Σ j, withMBO Y j) : Σ j, Y j := ⟨y.1, y.2.1⟩ /-- A reply with the MBO `b`. -/ def tagMBO (b : Bool) (y : Σ j, Y j) : Σ j, withMBO Y j := ⟨y.1, (y.2, b)⟩ -@[simp] theorem forgetMBO_tagMBO (b : Bool) (y : Σ j, Y j) : forgetMBO (tagMBO b y) = y := rfl +@[simp] lemma forgetMBO_tagMBO (b : Bool) (y : Σ j, Y j) : forgetMBO (tagMBO b y) = y := rfl -@[simp] theorem tagMBO_fst (b : Bool) (y : Σ j, Y j) : (tagMBO b y).1 = y.1 := rfl +@[simp] lemma tagMBO_fst (b : Bool) (y : Σ j, Y j) : (tagMBO b y).1 = y.1 := rfl end Replies @@ -97,7 +97,7 @@ def sumMBO (f : List (A × Σ j, withMBO Y j) → ℝ) : List (A × Σ j, Y j) | z :: t => sumMBO (fun k => f ((z.1, tagMBO false z.2) :: k)) t + sumMBO (fun k => f ((z.1, tagMBO true z.2) :: k)) t -theorem sumMBO_snoc (f : List (A × Σ j, withMBO Y j) → ℝ) (h : List (A × Σ j, Y j)) +lemma sumMBO_snoc (f : List (A × Σ j, withMBO Y j) → ℝ) (h : List (A × Σ j, Y j)) (z : A × Σ j, Y j) : sumMBO f (h ++ [z]) = sumMBO (fun k => f (k ++ [(z.1, tagMBO false z.2)]) + f (k ++ [(z.1, tagMBO true z.2)])) @@ -112,7 +112,7 @@ theorem sumMBO_snoc (f : List (A × Σ j, withMBO Y j) → ℝ) (h : List (A × -- The induction hypothesis, for each of the two shifted summands. rw [ih, ih] -theorem sumMBO_sum {ι : Type} (s : Finset ι) (f : ι → List (A × Σ j, withMBO Y j) → ℝ) +lemma sumMBO_sum {ι : Type} (s : Finset ι) (f : ι → List (A × Σ j, withMBO Y j) → ℝ) (h : List (A × Σ j, Y j)) : sumMBO (fun k => ∑ i ∈ s, f i k) h = ∑ i ∈ s, sumMBO (f i) h := by -- Induction on h: a finite sum passes through each branch of sumMBO. @@ -123,14 +123,14 @@ theorem sumMBO_sum {ι : Type} (s : Finset ι) (f : ι → List (A × Σ j, with simp only [sumMBO] rw [ih, ih, ← Finset.sum_add_distrib] -theorem sumMBO_nonneg {f : List (A × Σ j, withMBO Y j) → ℝ} (hf : ∀ k, 0 ≤ f k) +lemma sumMBO_nonneg {f : List (A × Σ j, withMBO Y j) → ℝ} (hf : ∀ k, 0 ≤ f k) (h : List (A × Σ j, Y j)) : 0 ≤ sumMBO f h := by -- Induction on h: a sum of the nonnegative values of f. induction h generalizing f with | nil => exact hf [] | cons z t ih => exact add_nonneg (ih fun k => hf _) (ih fun k => hf _) -theorem sumMBO_zero (h : List (A × Σ j, Y j)) : +lemma sumMBO_zero (h : List (A × Σ j, Y j)) : sumMBO (fun _ : List (A × Σ j, withMBO Y j) => (0 : ℝ)) h = 0 := by -- Induction on h: every branch sums zeros. induction h with @@ -139,7 +139,7 @@ theorem sumMBO_zero (h : List (A × Σ j, Y j)) : open scoped Classical in /-- A condition on the queries passes through the sum over MBOs. -/ -theorem sumMBO_ite (P : List A → Prop) (f : List (A × Σ j, withMBO Y j) → ℝ) +lemma sumMBO_ite (P : List A → Prop) (f : List (A × Σ j, withMBO Y j) → ℝ) (h : List (A × Σ j, Y j)) : sumMBO (fun k => if P (k.map Prod.fst) then f k else 0) h = if P (h.map Prod.fst) then sumMBO f h else 0 := by @@ -156,7 +156,7 @@ theorem sumMBO_ite (P : List A → Prop) (f : List (A × Σ j, withMBO Y j) → split_ifs <;> simp /-- A factor depending only on the queries passes through the sum over MBOs. -/ -theorem sumMBO_mul_fst (f : List (A × Σ j, withMBO Y j) → ℝ) (g : List A → ℝ) +lemma sumMBO_mul_fst (f : List (A × Σ j, withMBO Y j) → ℝ) (g : List A → ℝ) (h : List (A × Σ j, Y j)) : sumMBO (fun k => f k * g (k.map Prod.fst)) h = sumMBO f h * g (h.map Prod.fst) := by -- Induction on h, for every f and g: as in sumMBO_ite, the factor g depends only on the @@ -171,7 +171,7 @@ theorem sumMBO_mul_fst (f : List (A × Σ j, withMBO Y j) → ℝ) (g : List A -- a·c + b·c = (a + b)·c. ring -theorem sumMBO_const_mul (c : ℝ) (f : List (A × Σ j, withMBO Y j) → ℝ) (h : List (A × Σ j, Y j)) : +lemma sumMBO_const_mul (c : ℝ) (f : List (A × Σ j, withMBO Y j) → ℝ) (h : List (A × Σ j, Y j)) : sumMBO (fun k => c * f k) h = c * sumMBO f h := by -- Induction on h: the constant factor passes through both branches. induction h generalizing f with @@ -181,7 +181,7 @@ theorem sumMBO_const_mul (c : ℝ) (f : List (A × Σ j, withMBO Y j) → ℝ) ( rw [ih, ih] ring -theorem eq_tagMBO_iff {v : Σ j, withMBO Y j} {c : Bool} {y : Σ j, Y j} : +lemma eq_tagMBO_iff {v : Σ j, withMBO Y j} {c : Bool} {y : Σ j, Y j} : v = tagMBO c y ↔ forgetMBO v = y ∧ v.2.2 = c := by -- A reply with its MBO is determined by the reply without it and the MBO. constructor @@ -192,7 +192,7 @@ theorem eq_tagMBO_iff {v : Σ j, withMBO Y j} {c : Bool} {y : Σ j, Y j} : open scoped Classical in /-- A reply forgets its MBO into `y` exactly when it is `y` with one of the two MBOs. -/ -theorem ite_tagMBO_add (p : Part (Σ j, withMBO Y j)) (y : Σ j, Y j) : +lemma ite_tagMBO_add (p : Part (Σ j, withMBO Y j)) (y : Σ j, Y j) : ((if p = Part.some (tagMBO false y) then 1 else 0) + (if p = Part.some (tagMBO true y) then 1 else 0) : ℝ) = if p.map forgetMBO = Part.some y then 1 else 0 := by @@ -213,7 +213,7 @@ theorem ite_tagMBO_add (p : Part (Σ j, withMBO Y j)) (y : Σ j, Y j) : open scoped Classical in /-- **The sum over MBOs of the transcripts of a system** is the indicator of the transcripts of the system with the MBO forgotten. -/ -theorem sumMBO_replies (t : System A (Σ j, withMBO Y j)) (h : List (A × Σ j, Y j)) : +lemma sumMBO_replies (t : System A (Σ j, withMBO Y j)) (h : List (A × Σ j, Y j)) : sumMBO (fun k => if Replies t (k.map Prod.fst) (k.map Prod.snd) then 1 else 0) h = if Replies (relabel t id forgetMBO) (h.map Prod.fst) (h.map Prod.snd) then 1 else 0 := by -- t is a deterministic system whose replies carry the MBO; relabel t id forgetMBO is t with @@ -263,22 +263,22 @@ def forgetMBOs (h : List (A × Σ j, withMBO Y j)) : List (A × Σ j, Y j) := def unsetMBOs (h : List (A × Σ j, Y j)) : List (A × Σ j, withMBO Y j) := h.map fun z => (z.1, tagMBO false z.2) -@[simp] theorem forgetMBOs_unsetMBOs (h : List (A × Σ j, Y j)) : forgetMBOs (unsetMBOs h) = h := by +@[simp] lemma forgetMBOs_unsetMBOs (h : List (A × Σ j, Y j)) : forgetMBOs (unsetMBOs h) = h := by -- Giving each reply MBO 0 and then forgetting it is the identity on each entry. simp [forgetMBOs, unsetMBOs, Function.comp_def] -theorem map_fst_forgetMBOs (h : List (A × Σ j, withMBO Y j)) : +lemma map_fst_forgetMBOs (h : List (A × Σ j, withMBO Y j)) : (forgetMBOs h).map Prod.fst = h.map Prod.fst := by -- Forgetting the MBOs keeps the queries. simp [forgetMBOs, Function.comp_def] -theorem map_snd_forgetMBOs (h : List (A × Σ j, withMBO Y j)) : +lemma map_snd_forgetMBOs (h : List (A × Σ j, withMBO Y j)) : (forgetMBOs h).map Prod.snd = (h.map Prod.snd).map forgetMBO := by -- The replies of the forgotten transcript are the replies with their MBOs forgotten. simp [forgetMBOs, Function.comp_def] /-- Each transcript is one of the terms of the sum over the MBOs of its visible transcript. -/ -theorem le_sumMBO {f : List (A × Σ j, withMBO Y j) → ℝ} (hf : ∀ k, 0 ≤ f k) +lemma le_sumMBO {f : List (A × Σ j, withMBO Y j) → ℝ} (hf : ∀ k, 0 ≤ f k) (k : List (A × Σ j, withMBO Y j)) : f k ≤ sumMBO f (forgetMBOs k) := by -- Induction on k, for every nonnegative f. The first entry z of k, with MBO b, lies on the -- b-branch of the sum over MBOs of forgetMBOs k; the other branch is nonnegative. @@ -311,7 +311,7 @@ variable {E : List A → Prop} {m : ℕ} {hE : ∀ h, E h → h.length ≤ m} open scoped Classical in /-- **The replies with both MBOs** to a query after a transcript `k` weigh `k` if the query is admitted, and nothing otherwise. -/ -theorem RandomSystem.sum_tagMBO (G : RandomSystem A (Σ j, withMBO Y j) (Domain.ofInputs E m hE)) +lemma RandomSystem.sum_tagMBO (G : RandomSystem A (Σ j, withMBO Y j) (Domain.ofInputs E m hE)) (k : List (A × Σ j, withMBO Y j)) (x : A) : ∑ y : Σ j, Y j, (G (k ++ [(x, tagMBO false y)]) + G (k ++ [(x, tagMBO true y)])) = if E (k.map Prod.fst ++ [x]) then G k else 0 := by @@ -361,13 +361,13 @@ noncomputable def RandomSystem.visible simp only [G.sum_tagMBO, Domain.ofInputs_apply] exact sumMBO_ite (fun xs => E (xs ++ [x])) G h⟩ -theorem RandomSystem.visible_apply +lemma RandomSystem.visible_apply (G : RandomSystem A (Σ j, withMBO Y j) (Domain.ofInputs E m hE)) (h : List (A × Σ j, Y j)) : G.visible h = sumMBO G h := rfl end Visible -theorem RandomSystem.RepliesAtQueriedInterface.visible {I : Type} [Fintype I] +lemma RandomSystem.RepliesAtQueriedInterface.visible {I : Type} [Fintype I] {X Y : I → Type} [∀ i, Fintype (X i)] [∀ i, Fintype (Y i)] {E : List (Σ i, X i) → Prop} {m : ℕ} {hE : ∀ h, E h → h.length ≤ m} {G : RandomSystem (Σ i, X i) (Σ i, withMBO Y i) (Domain.ofInputs E m hE)} @@ -383,7 +383,7 @@ theorem RandomSystem.RepliesAtQueriedInterface.visible {I : Type} [Fintype I] exact sumMBO_zero h /-- A game replies at the queried interface when its visible system does. -/ -theorem RandomSystem.RepliesAtQueriedInterface.of_visible {I : Type} [Fintype I] +lemma RandomSystem.RepliesAtQueriedInterface.of_visible {I : Type} [Fintype I] {X Y : I → Type} [∀ i, Fintype (X i)] [∀ i, Fintype (Y i)] {E : List (Σ i, X i) → Prop} {m : ℕ} {hE : ∀ h, E h → h.length ≤ m} {G : RandomSystem (Σ i, X i) (Σ i, withMBO Y i) (Domain.ofInputs E m hE)} @@ -413,7 +413,7 @@ def DDE.blindMBO (e : DDE (Σ i, X i) (Σ i, Y i)) : DDE (Σ i, X i) (Σ i, with (by simpa only [List.map_append, List.map_cons, List.map_nil] using hd)⟩ omit [Fintype I] [∀ i, Fintype (X i)] [∀ i, Fintype (Y i)] in -theorem cons_blindMBO_iff (e : DDE (Σ i, X i) (Σ i, Y i)) +lemma cons_blindMBO_iff (e : DDE (Σ i, X i) (Σ i, Y i)) (h : List ((Σ i, X i) × Σ i, withMBO Y i)) : Cons (DDE.blindMBO e).1 h ↔ Cons e.1 (forgetMBOs h) := by -- Query i of the blinded environment is e's query on the first i replies with their MBOs @@ -423,7 +423,7 @@ theorem cons_blindMBO_iff (e : DDE (Σ i, X i) (Σ i, Y i)) rfl omit [Fintype I] [∀ i, Fintype (X i)] [∀ i, Fintype (Y i)] in -theorem good_blindMBO_iff (e : DDE (Σ i, X i) (Σ i, Y i)) (n : ℕ) +lemma good_blindMBO_iff (e : DDE (Σ i, X i) (Σ i, Y i)) (n : ℕ) (h : List ((Σ i, X i) × Σ i, withMBO Y i)) : Good (DDE.blindMBO e).1 n h ↔ Good e.1 n (forgetMBOs h) := by -- Good = Cons ∧ Done; Cons by cons_blindMBO_iff. Done depends on the length and on whether @@ -439,7 +439,7 @@ def finalMBO {A : Type} (h : List (A × Σ i, withMBO Y i)) : Bool := omit [Fintype I] [∀ i, Fintype (Y i)] in /-- Along a transcript whose MBO, once set, stays set, the final MBO is set exactly when some MBO is. -/ -theorem finalMBO_eq_true_iff {A : Type} {h : List (A × Σ i, withMBO Y i)} +lemma finalMBO_eq_true_iff {A : Type} {h : List (A × Σ i, withMBO Y i)} (hp : (h.map fun z => z.2.2.2).Pairwise (· ≤ ·)) : finalMBO h = true ↔ ¬ ∀ z ∈ h, z.2.2.2 = false := by -- Only the last entry z matters: h is empty or ends with z. @@ -493,7 +493,7 @@ noncomputable def RandomSystem.unsetProbability {D' : Domain (Σ i, X i) (Σ i, (G.sLaw (DDE.ofQueries xs).1 xs.length).mass fun h => ∀ z ∈ h, z.2.2.2 = false /-- Before any query, the MBO is unset. -/ -theorem RandomSystem.unsetProbability_nil {D' : Domain (Σ i, X i) (Σ i, withMBO Y i)} +lemma RandomSystem.unsetProbability_nil {D' : Domain (Σ i, X i) (Σ i, withMBO Y i)} (G : RandomSystem (Σ i, X i) (Σ i, withMBO Y i) D') : G.unsetProbability [] = 1 := by -- The environment asking no queries is compatible with G: it never asks. have hc : G.Compatible (DDE.ofQueries ([] : List (Σ i, X i))).1 := by @@ -543,7 +543,7 @@ variable {E : List (Σ i, X i) → Prop} {m : ℕ} {hE : ∀ h, E h → h.length /-- A random system on the input domain admits the fixed queries of a possible transcript of another one. -/ -theorem RandomSystem.compatible_fixedQueries {B : Type} [Fintype B] +lemma RandomSystem.compatible_fixedQueries {B : Type} [Fintype B] (R : RandomSystem (Σ i, X i) B (Domain.ofInputs E m hE)) {T : RandomSystem (Σ i, X i) (Σ i, Y i) (Domain.ofInputs E m hE)} {h : List ((Σ i, X i) × Σ i, Y i)} (hT : T h ≠ 0) : @@ -579,7 +579,7 @@ open scoped Classical in /-- **Winning is one minus the unset mass**: the winning probability of a deterministic distinguisher is one minus the mass of its transcripts on which the MBO stays unset, which on each transcript it may produce is the mass of the game with the MBO unset. -/ -theorem RandomSystem.exists_unset_winProbability +lemma RandomSystem.exists_unset_winProbability {G : RandomSystem (Σ i, X i) (Σ i, withMBO Y i) (Domain.ofInputs E m hE)} (hG : G.RepliesAtQueriedInterface) (hm : G.MonotoneMBO) (D : DDD I X Y) (hD : IsDDD D) (hdc : (Domain.ofInputs E m hE : Domain (Σ i, X i) (Σ i, Y i)).DecisionCompatible D) : diff --git a/src/RandomSystems/Game/MBOAttachment.lean b/src/RandomSystems/Game/MBOAttachment.lean index 4569881..f3dcf0c 100644 --- a/src/RandomSystems/Game/MBOAttachment.lean +++ b/src/RandomSystems/Game/MBOAttachment.lean @@ -54,7 +54,7 @@ def inputMBO : (Σ l, twoFam U (withMBO Y) l) → Option Bool def latestMBO (h : List (Σ l, twoFam U (withMBO Y) l)) : Bool := (h.reverse.findSome? inputMBO).getD false -theorem latestMBO_snoc (h : List (Σ l, twoFam U (withMBO Y) l)) (z : Σ l, twoFam U (withMBO Y) l) : +lemma latestMBO_snoc (h : List (Σ l, twoFam U (withMBO Y) l)) (z : Σ l, twoFam U (withMBO Y) l) : latestMBO (h ++ [z]) = (inputMBO z).getD (latestMBO h) := by -- The latest MBO is found by searching the reversed history, which starts with `z`: it is the -- MBO of `z` if `z` is an inside reply, and the latest MBO of `h` otherwise. @@ -62,7 +62,7 @@ theorem latestMBO_snoc (h : List (Σ l, twoFam U (withMBO Y) l)) (z : Σ l, twoF List.singleton_append, List.findSome?_cons] cases inputMBO z <;> rfl -@[simp] theorem latestMBO_nil : latestMBO ([] : List (Σ l, twoFam U (withMBO Y) l)) = false := rfl +@[simp] lemma latestMBO_nil : latestMBO ([] : List (Σ l, twoFam U (withMBO Y) l)) = false := rfl /-- **The MBO-forwarding lift** of a converter: it runs the converter on the inside replies without their MBO, and tags each outside reply with the MBO of the latest inside reply. -/ @@ -83,27 +83,27 @@ def liftMBO (a : InsideOutsideSystem O J U V X Y) : -- outside inside fun h => (a (h.map (insideMap forgetMBO))).map (outsideMap (tagMBO (latestMBO h))) -theorem insideMap_forgetMBO_fst (z : Σ l, twoFam U (withMBO Y) l) : +lemma insideMap_forgetMBO_fst (z : Σ l, twoFam U (withMBO Y) l) : (insideMap forgetMBO z).1 = z.1 := by -- Outside query or inside reply: forgetting the MBO keeps the label. rcases z with ⟨⟨_ | ⟨⟨⟩⟩, j⟩, y⟩ <;> rfl -theorem outsideMap_tagMBO_fst (b : Bool) (y : Σ l, twoFam V X l) : +lemma outsideMap_tagMBO_fst (b : Bool) (y : Σ l, twoFam V X l) : (outsideMap (tagMBO b) y).1 = y.1 := by -- Outside reply or inside query: tagging keeps the label. rcases y with ⟨⟨_ | ⟨⟨⟩⟩, j⟩, y⟩ <;> rfl -theorem outsideMap_forgetMBO_fst (y : Σ l, twoFam (withMBO V) X l) : +lemma outsideMap_forgetMBO_fst (y : Σ l, twoFam (withMBO V) X l) : (outsideMap forgetMBO y).1 = y.1 := by -- Outside reply or inside query: forgetting the MBO keeps the label. rcases y with ⟨⟨_ | ⟨⟨⟩⟩, j⟩, y⟩ <;> rfl -@[simp] theorem outsideMap_forgetMBO_tagMBO (b : Bool) (y : Σ l, twoFam V X l) : +@[simp] lemma outsideMap_forgetMBO_tagMBO (b : Bool) (y : Σ l, twoFam V X l) : outsideMap forgetMBO (outsideMap (tagMBO b) y) = y := by -- On an outside reply, forgetting the tag undoes it; an inside query is untouched. rcases y with ⟨⟨_ | ⟨⟨⟩⟩, j⟩, y⟩ <;> rfl -theorem mem_liftMBO {a : InsideOutsideSystem O J U V X Y} {h} {y} : +lemma mem_liftMBO {a : InsideOutsideSystem O J U V X Y} {h} {y} : y ∈ liftMBO a h ↔ outsideMap forgetMBO y ∈ a (h.map (insideMap forgetMBO)) ∧ y = outsideMap (tagMBO (latestMBO h)) (outsideMap forgetMBO y) := by -- An output of the lift is the tag of an output `y₀` of `a` on the history without MBOs; @@ -117,12 +117,12 @@ theorem mem_liftMBO {a : InsideOutsideSystem O J U V X Y} {h} {y} : · rintro ⟨hy, he⟩ exact (Part.mem_map_iff _).mpr ⟨_, hy, he.symm⟩ -theorem liftMBO_dom (a : InsideOutsideSystem O J U V X Y) (h) : +lemma liftMBO_dom (a : InsideOutsideSystem O J U V X Y) (h) : (liftMBO a h).Dom ↔ (a (h.map (insideMap forgetMBO))).Dom := Iff.rfl /-- **The lift without its outside MBOs** is the converter run on the inside replies without their MBO. -/ -theorem relabel_liftMBO (a : InsideOutsideSystem O J U V X Y) : +lemma relabel_liftMBO (a : InsideOutsideSystem O J U V X Y) : relabel (liftMBO a) id (outsideMap forgetMBO) = relabel a (insideMap forgetMBO) id := by -- Cutting the MBO wire in the picture at `liftMBO`: on each history, both sides run `a` on the -- history without inside MBOs, and on the left the tag is added and forgotten again. @@ -133,7 +133,7 @@ theorem relabel_liftMBO (a : InsideOutsideSystem O J U V X Y) : funext y simp -theorem replyLabel_liftMBO (a : InsideOutsideSystem O J U V X Y) (h) : +lemma replyLabel_liftMBO (a : InsideOutsideSystem O J U V X Y) (h) : replyLabel (liftMBO a) h = replyLabel a (h.map (insideMap forgetMBO)) := by -- The lift replies exactly when `a` does on the history without MBOs (`liftMBO_dom`), and -- tagging keeps the label of the reply. @@ -145,7 +145,7 @@ theorem replyLabel_liftMBO (a : InsideOutsideSystem O J U V X Y) (h) : -- Neither replies. · rw [dif_neg hd, dif_neg (fun h' => hd ((liftMBO_dom a h).mp h'))] -theorem lastOuter_insideMap_forgetMBO (h : List (Σ l, twoFam U (withMBO Y) l)) : +lemma lastOuter_insideMap_forgetMBO (h : List (Σ l, twoFam U (withMBO Y) l)) : lastOuter (h.map (insideMap forgetMBO)) = lastOuter h := by -- Induction from the right: forgetting the MBO of an inside reply changes no label, and an -- outside query is kept as it is. @@ -155,7 +155,7 @@ theorem lastOuter_insideMap_forgetMBO (h : List (Σ l, twoFam U (withMBO Y) l)) rw [List.map_append, List.map_singleton, lastOuter_snoc, lastOuter_snoc, ih] rcases z with ⟨⟨_ | ⟨⟨⟩⟩, j⟩, y⟩ <;> rfl -theorem insideRun_liftMBO (a : InsideOutsideSystem O J U V X Y) (h) : +lemma insideRun_liftMBO (a : InsideOutsideSystem O J U V X Y) (h) : insideRun (liftMBO a) h = insideRun a (h.map (insideMap forgetMBO)) := by -- `insideRun` counts the consecutive inside queries at the end. Induction from the right: one -- more input adds one to the count exactly when the output after it is an inside query, and @@ -183,7 +183,7 @@ theorem insideRun_liftMBO (a : InsideOutsideSystem O J U V X Y) (h) : exact hi /-- The lift of a DDC is a DDC with the same bound. -/ -theorem IsDDC.liftMBO {b : ℕ} {a : InsideOutsideSystem O J U V X Y} (ha : IsDDC b a) : +lemma IsDDC.liftMBO {b : ℕ} {a : InsideOutsideSystem O J U V X Y} (ha : IsDDC b a) : IsDDC b (SystemAlgebra.liftMBO a) where -- Silent at the empty history and prefix closed: both are statements about domains, and the -- lift has the domain of `a` on the history without MBOs; prefixes map to prefixes. @@ -218,7 +218,7 @@ def TaggedMBO ∀ p z t, h = p ++ z :: t → z.2 = outsideMap (tagMBO (latestMBO (p.map Prod.fst ++ [z.1]))) (outsideMap forgetMBO z.2) -theorem taggedMBO_snoc +lemma taggedMBO_snoc {h : List ((Σ l, twoFam U (withMBO Y) l) × (Σ l, twoFam (withMBO V) X l))} {z} : TaggedMBO (h ++ [z]) ↔ TaggedMBO h ∧ z.2 = outsideMap (tagMBO (latestMBO (h.map Prod.fst ++ [z.1]))) @@ -245,7 +245,7 @@ theorem taggedMBO_snoc /-- **The transcripts of a lift** are the transcripts of the converter with the MBOs forgotten whose outside replies carry the latest inside MBO. -/ -theorem replies_liftMBO_iff (a : InsideOutsideSystem O J U V X Y) +lemma replies_liftMBO_iff (a : InsideOutsideSystem O J U V X Y) (h : List ((Σ l, twoFam U (withMBO Y) l) × (Σ l, twoFam (withMBO V) X l))) : Replies (liftMBO a) (h.map Prod.fst) (h.map Prod.snd) ↔ Replies a ((forgetConverterMBO h).map Prod.fst) ((forgetConverterMBO h).map Prod.snd) ∧ @@ -276,7 +276,7 @@ theorem replies_liftMBO_iff (a : InsideOutsideSystem O J U V X Y) tauto /-- Forgetting the MBOs keeps the labels of a converter transcript. -/ -theorem admitted_forgetConverterMBO +lemma admitted_forgetConverterMBO (h : List ((Σ l, twoFam U (withMBO Y) l) × (Σ l, twoFam (withMBO V) X l))) : Admitted converterAdmits (forgetConverterMBO h) ↔ Admitted converterAdmits h := -- Forgetting MBOs relabels inputs and outputs and keeps every label (the label map is the @@ -285,7 +285,7 @@ theorem admitted_forgetConverterMBO (fun z => by rw [insideMap_forgetMBO_fst]; rcases z with ⟨⟨_ | ⟨⟨⟩⟩, j⟩, y⟩ <;> rfl) (fun z => by rw [outsideMap_forgetMBO_fst]; rcases z with ⟨⟨_ | ⟨⟨⟩⟩, j⟩, y⟩ <;> rfl) h -theorem outsideInputs_insideMap_forgetMBO (xs : List (Σ l, twoFam U (withMBO Y) l)) : +lemma outsideInputs_insideMap_forgetMBO (xs : List (Σ l, twoFam U (withMBO Y) l)) : outsideInputs (xs.map (insideMap forgetMBO)) = outsideInputs xs := by -- Induction from the right: an outside query is kept as it is, and an inside reply adds no -- outside input, with or without its MBO. @@ -301,7 +301,7 @@ theorem outsideInputs_insideMap_forgetMBO (xs : List (Σ l, twoFam U (withMBO Y) variable {E : List (Σ j, X j) → Prop} {F : List (Σ o, U o) → Prop} /-- Forgetting the MBOs keeps the converter domain. -/ -theorem converterDomain_forgetConverterMBO +lemma converterDomain_forgetConverterMBO (h : List ((Σ l, twoFam U (withMBO Y) l) × (Σ l, twoFam (withMBO V) X l))) (x : Σ l, twoFam U (withMBO Y) l) : converterDomain E F (forgetConverterMBO h) (insideMap forgetMBO x) ↔ @@ -327,7 +327,7 @@ theorem converterDomain_forgetConverterMBO simp only [converterDomain, admitted_forgetConverterMBO, hadm, hout, hin] /-- **The lift of a DDC from `E` to `F`** is a DDC from `E` to `F`. -/ -theorem IsDDCFrom.liftMBO {b : ℕ} {a : InsideOutsideSystem O J U V X Y} +lemma IsDDCFrom.liftMBO {b : ℕ} {a : InsideOutsideSystem O J U V X Y} (ha : IsDDCFrom E F b a) : IsDDCFrom E F b (SystemAlgebra.liftMBO a) where -- The DDC conditions: `IsDDC.liftMBO`. isDDC := ha.isDDC.liftMBO @@ -349,7 +349,7 @@ theorem IsDDCFrom.liftMBO {b : ℕ} {a : InsideOutsideSystem O J U V X Y} open scoped Classical in /-- Lifting commutes with restricting to the outside inputs in a domain. -/ -theorem liftMBO_filterDom (P : List (Σ o, U o) → Prop) (a : InsideOutsideSystem O J U V X Y) : +lemma liftMBO_filterDom (P : List (Σ o, U o) → Prop) (a : InsideOutsideSystem O J U V X Y) : liftMBO (filterDom (fun h => P (outsideInputs h)) a) = filterDom (fun h => P (outsideInputs h)) (liftMBO a) := by -- The restriction tests the outside inputs, which forgetting the inside MBOs keeps; the tag @@ -358,7 +358,7 @@ theorem liftMBO_filterDom (P : List (Σ o, U o) → Prop) (a : InsideOutsideSyst simp only [liftMBO, filterDom, outsideInputs_insideMap_forgetMBO] split_ifs <;> simp -theorem admissible_liftMBO_iff (a : InsideOutsideSystem O J U V X Y) (h) : +lemma admissible_liftMBO_iff (a : InsideOutsideSystem O J U V X Y) (h) : Admissible (liftMBO a) h ↔ Admissible a (h.map (insideMap forgetMBO)) := by -- Induction from the right: admissibility of one more input asks for a defined reply before it -- and for its admission; both are the same for the lift and for `a` without MBOs. @@ -371,7 +371,7 @@ theorem admissible_liftMBO_iff (a : InsideOutsideSystem O J U V X Y) (h) : open scoped Classical in /-- Lifting commutes with restricting a converter to its admissible histories. -/ -theorem liftMBO_canon (a : InsideOutsideSystem O J U V X Y) : +lemma liftMBO_canon (a : InsideOutsideSystem O J U V X Y) : liftMBO (canon a) = canon (liftMBO a) := by -- `canon` restricts to admissible histories, and the lift is admissible exactly where `a` is -- on the history without MBOs (`admissible_liftMBO_iff`). @@ -381,7 +381,7 @@ theorem liftMBO_canon (a : InsideOutsideSystem O J U V X Y) : /-- **The lift of the forwarding converter** is the forwarding converter: an outside reply forwards the latest inside reply with its MBO. -/ -theorem liftMBO_forwardAll : liftMBO (forwardAll J X Y) = forwardAll J X (withMBO Y) := by +lemma liftMBO_forwardAll : liftMBO (forwardAll J X Y) = forwardAll J X (withMBO Y) := by -- The forwarding converter forwards the last input. Case on the history. funext h rcases List.eq_nil_or_concat h with rfl | ⟨h, z, rfl⟩ @@ -403,7 +403,7 @@ theorem liftMBO_forwardAll : liftMBO (forwardAll J X Y) = forwardAll J X (withMB rfl /-- **The lift of a filter** is the filter on replies with the MBO. -/ -theorem liftMBO_filter (D : List (Σ j, X j) → Prop) (hD : ∀ {p h}, p <+: h → D h → D p) : +lemma liftMBO_filter (D : List (Σ j, X j) → Prop) (hD : ∀ {p h}, p <+: h → D h → D p) : liftMBO (DDC.filter (Y := Y) D hD).1 = (DDC.filter (Y := withMBO Y) D hD).1 := by -- The filter is the forwarding converter made canonical and restricted on its outside inputs; -- the lift commutes with each of the three. @@ -434,7 +434,7 @@ omit [Fintype O] [Fintype J] [∀ o, Fintype (U o)] [∀ o, Fintype (V o)] [∀ open scoped Classical in /-- On a converter transcript, the lifted presentation gives the mass of the transcript with the MBOs forgotten when its outside replies carry the latest inside MBO, and zero otherwise. -/ -theorem behaviorMass_liftPresentation {b : ℕ} +lemma behaviorMass_liftPresentation {b : ℕ} (P : Distribution.ProbDist {a : InsideOutsideSystem O J U V X Y // IsDDCFrom E F b a}) (h : List ((Σ l, twoFam U (withMBO Y) l) × (Σ l, twoFam (withMBO V) X l))) : behaviorMass (liftPresentation P).1 (h.map Prod.fst) (h.map Prod.snd) = @@ -459,7 +459,7 @@ noncomputable def PDCBehavior.liftMBO (α : PDCBehavior O J U V X Y E m hE F n h open scoped Classical in /-- **The transcripts of a lifted PDC**: the mass of a transcript with the MBOs forgotten, when its outside replies carry the latest inside MBO. -/ -theorem PDCBehavior.liftMBO_apply (α : PDCBehavior O J U V X Y E m hE F n hF) +lemma PDCBehavior.liftMBO_apply (α : PDCBehavior O J U V X Y E m hE F n hF) (h : List ((Σ l, twoFam U (withMBO Y) l) × (Σ l, twoFam (withMBO V) X l))) : (PDCBehavior.liftMBO α).1 h = if TaggedMBO h then α.1 (forgetConverterMBO h) else 0 := by -- The lift is defined from a chosen presentation of `α`; compute on it @@ -468,7 +468,7 @@ theorem PDCBehavior.liftMBO_apply (α : PDCBehavior O J U V X Y E m hE F n hF) rw [behaviorMass_liftPresentation, α.2.choose_spec.choose_spec] /-- Any presentation of a PDC lifts to a presentation of its lift. -/ -theorem PDCBehavior.liftMBO_presents (α : PDCBehavior O J U V X Y E m hE F n hF) {b : ℕ} +lemma PDCBehavior.liftMBO_presents (α : PDCBehavior O J U V X Y E m hE F n hF) {b : ℕ} (P : Distribution.ProbDist {a : InsideOutsideSystem O J U V X Y // IsDDCFrom E F b a}) (hP : ∀ h, behaviorMass P.1 (h.map Prod.fst) (h.map Prod.snd) = α.1 h) (h) : behaviorMass (liftPresentation P).1 (h.map Prod.fst) (h.map Prod.snd) = @@ -478,7 +478,7 @@ theorem PDCBehavior.liftMBO_presents (α : PDCBehavior O J U V X Y E m hE F n hF open scoped Classical in /-- The lift of the behavior of a DDC is the behavior of its lift. -/ -theorem PDCBehavior.liftMBO_ofDDC (a : InsideOutsideSystem O J U V X Y) {b : ℕ} +lemma PDCBehavior.liftMBO_ofDDC (a : InsideOutsideSystem O J U V X Y) {b : ℕ} (ha : IsDDCFrom E F b a) : PDCBehavior.liftMBO (PDCBehavior.ofDDC a ha : PDCBehavior O J U V X Y E m hE F n hF) = PDCBehavior.ofDDC (SystemAlgebra.liftMBO a) ha.liftMBO := by @@ -492,7 +492,7 @@ theorem PDCBehavior.liftMBO_ofDDC (a : InsideOutsideSystem O J U V X Y) {b : ℕ by_cases ht : TaggedMBO h <;> simp [ht, forgetConverterMBO] /-- **The lift of the identity** is the identity. -/ -theorem PDCBehavior.liftMBO_id (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) : +lemma PDCBehavior.liftMBO_id (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) : PDCBehavior.liftMBO (PDCBehavior.id (Y := Y) (m := m) (hE := hE) hE') = PDCBehavior.id (Y := withMBO Y) hE' := by -- The identity PDC is the behavior of the filter DDC on `h = [] ∨ E h`, and the lift of the @@ -513,7 +513,7 @@ section Visible variable {O J : Type} {U V : O → Type} {X Y : J → Type} /-- Relabeling the outside replies of an attachment relabels those of the converter. -/ -theorem relabel_apply_outside {V' : O → Type} (c : InsideOutsideSystem O J U V' X Y) +lemma relabel_apply_outside {V' : O → Type} (c : InsideOutsideSystem O J U V' X Y) (R : InterfaceSystem J X Y) (g : (Σ o, V' o) → (Σ o, V o)) : relabel (apply c R) id g = apply (relabel c id (outsideMap g)) R := by -- Write both attachments as interconnections of `[c, R]`; relabeling the outside replies of @@ -529,7 +529,7 @@ theorem relabel_apply_outside {V' : O → Type} (c : InsideOutsideSystem O J U V /-- A converter relabeling its inside replies, attached to a resource, is the converter attached to the resource with its replies relabeled. -/ -theorem apply_relabel_inside {Y' : J → Type} (c : InsideOutsideSystem O J U V X Y) +lemma apply_relabel_inside {Y' : J → Type} (c : InsideOutsideSystem O J U V X Y) (R : InterfaceSystem J X Y') (k : (Σ j, Y' j) → (Σ j, Y j)) : apply (relabel c (insideMap k) id) R = apply c (relabel R id k) := by -- Write both attachments as interconnections of `[c, R]`; relabeling the inputs of `c`, or the @@ -545,7 +545,7 @@ theorem apply_relabel_inside {Y' : J → Type} (c : InsideOutsideSystem O J U V /-- **Attaching a lift and forgetting the MBO** is attaching the converter to the system with the MBO forgotten. -/ -theorem relabel_trim_apply_liftMBO (a : InsideOutsideSystem O J U V X Y) +lemma relabel_trim_apply_liftMBO (a : InsideOutsideSystem O J U V X Y) (s : InterfaceSystem J X (withMBO Y)) : relabel (trim (apply (liftMBO a) s)) id forgetMBO = trim (apply a (relabel s id forgetMBO)) := by @@ -588,7 +588,7 @@ noncomputable def visiblePresentation omit [Fintype O] [∀ o, Fintype (U o)] [∀ o, Fintype (V o)] in open scoped Classical in /-- The visible systems of a presentation of a game present its visible system. -/ -theorem behaviorMass_visiblePresentation +lemma behaviorMass_visiblePresentation (Q : Distribution.ProbDist {s : InterfaceSystem J X (withMBO Y) // IsDDS s ∧ RepliesAtQueriedInterface s ∧ ∀ h, (s h).Dom ↔ E h}) {G : RandomSystem (Σ j, X j) (Σ j, withMBO Y j) (Domain.ofInputs E m hE)} @@ -682,7 +682,7 @@ section Monotone variable {O J : Type} {U V : O → Type} {X Y : J → Type} -theorem latestMBO_eq (l : List (Σ l, twoFam U (withMBO Y) l)) : +lemma latestMBO_eq (l : List (Σ l, twoFam U (withMBO Y) l)) : latestMBO l = ((l.filterMap inputMBO).getLast?).getD false := by -- Induction from the right: one more input changes both sides exactly when it is an inside -- reply, and then both become its MBO. @@ -692,7 +692,7 @@ theorem latestMBO_eq (l : List (Σ l, twoFam U (withMBO Y) l)) : rw [latestMBO_snoc, ih, List.filterMap_append] rcases z with ⟨⟨_ | ⟨⟨⟩⟩, j⟩, y⟩ <;> simp [inputMBO] -theorem getLast?_getD_le {l : List Bool} {b : Bool} (hp : (l ++ [b]).Pairwise (· ≤ ·)) : +lemma getLast?_getD_le {l : List Bool} {b : Bool} (hp : (l ++ [b]).Pairwise (· ≤ ·)) : (l.getLast?).getD false ≤ b := by -- `l` is empty, or ends with `c`. rcases List.eq_nil_or_concat l with rfl | ⟨l, c, rfl⟩ @@ -714,7 +714,7 @@ def pendingMBO (ys : List (Two (Σ l, twoFam (withMBO V) X l) (Σ j, withMBO Y j /-- **Along an attachment of a converter that tags its outside replies with the latest inside MBO**, the resource replies with monotone MBOs as the converter receives them, and the exposed MBOs are monotone and below the latest inside MBO. -/ -theorem attach_tags_invariant {c : InsideOutsideSystem O J U (withMBO V) X (withMBO Y)} +lemma attach_tags_invariant {c : InsideOutsideSystem O J U (withMBO V) X (withMBO Y)} (hc : ∀ h (o : O) (v : withMBO V o), ⟨⟨none, o⟩, v⟩ ∈ c h → v.2 = latestMBO h) {R : InterfaceSystem J X (withMBO Y)} (hR : ∀ t : List ((Σ j, X j) × Σ j, withMBO Y j), Replies R (t.map Prod.fst) (t.map Prod.snd) → @@ -935,7 +935,7 @@ theorem attach_tags_invariant {c : InsideOutsideSystem O J U (withMBO V) X (with /-- **Attaching a converter that tags its outside replies with the latest inside MBO** to a resource with monotone MBOs gives transcripts with monotone MBOs. -/ -theorem replies_apply_monotone {c : InsideOutsideSystem O J U (withMBO V) X (withMBO Y)} +lemma replies_apply_monotone {c : InsideOutsideSystem O J U (withMBO V) X (withMBO Y)} (hc : ∀ h (o : O) (v : withMBO V o), ⟨⟨none, o⟩, v⟩ ∈ c h → v.2 = latestMBO h) {R : InterfaceSystem J X (withMBO Y)} (hR : ∀ t : List ((Σ j, X j) × Σ j, withMBO Y j), Replies R (t.map Prod.fst) (t.map Prod.snd) → @@ -948,7 +948,7 @@ theorem replies_apply_monotone {c : InsideOutsideSystem O J U (withMBO V) X (wit exact (attach_tags_invariant hc hR tr).2.2.1 /-- A lift tags its outside replies with the latest inside MBO. -/ -theorem liftMBO_tag (a : InsideOutsideSystem O J U V X Y) (h) (o : O) (v : withMBO V o) +lemma liftMBO_tag (a : InsideOutsideSystem O J U V X Y) (h) (o : O) (v : withMBO V o) (hv : ⟨⟨none, o⟩, v⟩ ∈ liftMBO a h) : v.2 = latestMBO h := by -- In the picture at `liftMBO`, the MBO wire tags the outside reply with `latestMBO h`. have he := (mem_liftMBO.mp hv).2 @@ -1030,7 +1030,7 @@ section TagRouting def latestBy {Z : Type} (b : Z → Option Bool) (h : List Z) : Bool := (h.reverse.findSome? b).getD false -theorem latestBy_snoc {Z : Type} (b : Z → Option Bool) (h : List Z) (z : Z) : +lemma latestBy_snoc {Z : Type} (b : Z → Option Bool) (h : List Z) (z : Z) : latestBy b (h ++ [z]) = (b z).getD (latestBy b h) := by -- The search runs over the reversed history, which starts with `z`: the bit of `z` if it has -- one, the latest bit of `h` otherwise. @@ -1038,7 +1038,7 @@ theorem latestBy_snoc {Z : Type} (b : Z → Option Bool) (h : List Z) (z : Z) : List.singleton_append, List.findSome?_cons] cases b z <;> rfl -theorem latestMBO_eq_latestBy {O J : Type} {U : O → Type} {Y : J → Type} +lemma latestMBO_eq_latestBy {O J : Type} {U : O → Type} {Y : J → Type} (h : List (Σ l, twoFam U (withMBO Y) l)) : latestMBO h = latestBy inputMBO h := rfl variable {Xβ Yβ Xα Yα A B : Type} @@ -1076,7 +1076,7 @@ def TagInvariant (bβ : Xβ → Option Bool) (bα : Xα → Option Bool) (bA : A (TagReady tα α (restrict (some ()) H) → (∀ H₀ z, H ≠ H₀ ++ [⟨some (), z⟩]) → latestBy bβ (restrict none H) = latestBy bα (restrict (some ()) H)) -theorem tagInvariant_feed (hr : TagRouting bβ bα bA tα α route inj) {u G y x} +lemma tagInvariant_feed (hr : TagRouting bβ bα bA tα α route inj) {u G y x} (hy : y ∈ pair β α G) (hx : route y = .inr x) (hi : TagInvariant bβ bα bA tα α u G) : TagInvariant bβ bα bA tα α u (G ++ [x]) := by -- One feed step: the pair answered the internal history `G` with `y`, and the routing feeds `y` @@ -1117,7 +1117,7 @@ theorem tagInvariant_feed (hr : TagRouting bβ bα bA tα α route inj) {u G y x -- Not to `α` (`α_to_α`). · exact absurd hx (hr.α_to_α yα x) -theorem tagInvariant_exchange (hr : TagRouting bβ bα bA tα α route inj) {u G o G'} +lemma tagInvariant_exchange (hr : TagRouting bβ bα bA tα α route inj) {u G o G'} (l : Exchange (pair β α) route G o G') (hi : TagInvariant bβ bα bA tα α u G) : TagInvariant bβ bα bA tα α u G' := by -- Induction on the exchange: silence and an exposed output end it, and each feed step keeps the @@ -1128,7 +1128,7 @@ theorem tagInvariant_exchange (hr : TagRouting bβ bα bA tα α route inj) {u G | feed _ y x _ _ hy hx _ ih => exact ih (tagInvariant_feed hr hy hx hi) /-- At the end of an exchange the inner component is not waiting with a tagged reply. -/ -theorem tagInvariant_end (hr : TagRouting bβ bα bA tα α route inj) {u G o G'} +lemma tagInvariant_end (hr : TagRouting bβ bα bA tα α route inj) {u G o G'} (l : Exchange (pair β α) route G o G') (hi : TagInvariant bβ bα bA tα α u G) : TagReady tα α (restrict (some ()) G') → latestBy bβ (restrict none G') = latestBy bα (restrict (some ()) G') := by @@ -1169,7 +1169,7 @@ theorem tagInvariant_end (hr : TagRouting bβ bα bA tα α route inj) {u G o G' exact absurd hs (by simp) /-- **The tag invariant along an interconnection.** -/ -theorem tagInvariant_induces (hr : TagRouting bβ bα bA tα α route inj) {u o H} +lemma tagInvariant_induces (hr : TagRouting bβ bα bA tα α route inj) {u o H} (ri : Induces (pair β α) route inj u o H) : TagInvariant bβ bα bA tα α u H ∧ (TagReady tα α (restrict (some ()) H) → latestBy bβ (restrict none H) = latestBy bα (restrict (some ()) H)) := by @@ -1202,7 +1202,7 @@ theorem tagInvariant_induces (hr : TagRouting bβ bα bA tα α route inj) {u o exact ⟨tagInvariant_exchange hr l hstart, tagInvariant_end hr l hstart⟩ /-- The final exposed output of an exchange is an output of the pair. -/ -theorem Exchange.exists_out {S : Type} {s : System Xβ S} {route' : S → B ⊕ Xβ} {G b G'} +lemma Exchange.exists_out {S : Type} {s : System Xβ S} {route' : S → B ⊕ Xβ} {G b G'} (l : Exchange s route' G (some b) G') : ∃ y ∈ s G', route' y = .inl b := by -- Induction on the exchange with its output fixed to `some b`: it ends with the exposed output -- `b` (`out`), and the feed steps carry it. @@ -1215,7 +1215,7 @@ theorem Exchange.exists_out {S : Type} {s : System Xβ S} {route' : S → B ⊕ /-- **An exposed output of the outer component carries the latest outside bit**, once the inner component has answered with a tagged reply: the outer component tags its exposed outputs with its latest bit. -/ -theorem tag_of_induces (hr : TagRouting bβ bα bA tα α route inj) (tB : B → Option Bool) +lemma tag_of_induces (hr : TagRouting bβ bα bA tα α route inj) (tB : B → Option Bool) (hβ : ∀ h y b c, y ∈ β h → route ⟨none, y⟩ = .inl b → tB b = some c → c = latestBy bβ h) (hαB : ∀ y b, route ⟨some (), y⟩ = .inl b → tB b = none) {u b H} (ri : Induces (pair β α) route inj u (some b) H) @@ -1267,7 +1267,7 @@ def outputMBO {O J : Type} {V : O → Type} {X : J → Type} : | ⟨⟨some (), _⟩, _⟩ => none /-- The MBO of an output of a lift is the latest inside MBO. -/ -theorem outputMBO_liftMBO {O J : Type} {U V : O → Type} {X Y : J → Type} +lemma outputMBO_liftMBO {O J : Type} {U V : O → Type} {X Y : J → Type} (a : InsideOutsideSystem O J U V X Y) {h y c} (hy : y ∈ liftMBO a h) (hc : outputMBO y = some c) : c = latestMBO h := by -- An outside reply carries the latest inside MBO (`liftMBO_tag`); an inside query carries none. @@ -1279,7 +1279,7 @@ theorem outputMBO_liftMBO {O J : Type} {U V : O → Type} {X Y : J → Type} /-- **Bits through a serial composition of lifts**: the inner lift tags its outside replies to the outer lift, its inside queries leave untagged, and the outer lift's queries carry no bit. -/ -theorem tagRouting_serialM (α : InsideOutsideSystem M J Xm Ym X Y) : +lemma tagRouting_serialM (α : InsideOutsideSystem M J Xm Ym X Y) : TagRouting (inputMBO (U := U) (Y := Ym)) (inputMBO (U := Xm) (Y := Y)) (inputMBO (U := U) (Y := Y)) outputMBO (liftMBO α) (serialRouteM (V := withMBO V) (Ym := withMBO Ym) (Yi := withMBO Y) (Xm := Xm) (Xi := X)) @@ -1332,7 +1332,7 @@ theorem tagRouting_serialM (α : InsideOutsideSystem M J Xm Ym X Y) : /-- **An outside reply of a serial composition of lifts carries the latest inside MBO**: when the outer lift replies outside, the inner lift is idle and its latest reply carried its latest inside MBO to the outer lift. -/ -theorem outputMBO_serialM_liftMBO {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} +lemma outputMBO_serialM_liftMBO {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} {α : InsideOutsideSystem M J Xm Ym X Y} (hβ : IsDDC bβ β) (hα : IsDDC bα α) {u w c} (hr : Reach (serialM (liftMBO β) (liftMBO α)) u) (hw : w ∈ serialM (liftMBO β) (liftMBO α) u) (hc : outputMBO w = some c) : c = latestMBO u := by @@ -1385,7 +1385,7 @@ theorem outputMBO_serialM_liftMBO {bβ bα : ℕ} {β : InsideOutsideSystem O M /-- **A serial composition of lifts without its outside MBOs** is the serial composition run on the inside replies without their MBO. -/ -theorem relabel_serialM_liftMBO (β : InsideOutsideSystem O M U V Xm Ym) +lemma relabel_serialM_liftMBO (β : InsideOutsideSystem O M U V Xm Ym) (α : InsideOutsideSystem M J Xm Ym X Y) : relabel (serialM (liftMBO β) (liftMBO α)) id (outsideMap forgetMBO) = relabel (serialM β α) (insideMap forgetMBO) id := by @@ -1434,7 +1434,7 @@ theorem relabel_serialM_liftMBO (β : InsideOutsideSystem O M U V Xm Ym) rcases u with ⟨⟨_ | ⟨⟨⟩⟩, l⟩, v⟩ <;> rfl /-- An output whose MBO, if any, is `b` is the output without its MBO tagged with `b`. -/ -theorem eq_tag_of_outputMBO {O J : Type} {V : O → Type} {X : J → Type} +lemma eq_tag_of_outputMBO {O J : Type} {V : O → Type} {X : J → Type} {y : Σ l, twoFam (withMBO V) X l} {b : Bool} (hy : ∀ c, outputMBO y = some c → c = b) : y = outsideMap (tagMBO b) (outsideMap forgetMBO y) := by -- An outside reply with MBO `b` is its own tag with `b`; tagging leaves an inside query alone. @@ -1445,7 +1445,7 @@ theorem eq_tag_of_outputMBO {O J : Type} {V : O → Type} {X : J → Type} · rfl /-- **The serial composition of lifts is the lift of the serial composition.** -/ -theorem trim_serialM_liftMBO {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} +lemma trim_serialM_liftMBO {bβ bα : ℕ} {β : InsideOutsideSystem O M U V Xm Ym} {α : InsideOutsideSystem M J Xm Ym X Y} (hβ : IsDDC bβ β) (hα : IsDDC bα α) : trim (serialM (liftMBO β) (liftMBO α)) = liftMBO (trim (serialM β α)) := by -- The serial composition of the lifts: @@ -1580,21 +1580,21 @@ def decisionBit : (Σ p, dOut U p) → Option Bool | ⟨.dec, b⟩ => some b | _ => none -theorem tagDecision_fst (b : Bool) (z : Σ p, dOut U p) : (tagDecision b z).1 = z.1 := by +lemma tagDecision_fst (b : Bool) (z : Σ p, dOut U p) : (tagDecision b z).1 = z.1 := by -- By cases on the port: replacing the decision keeps the port. rcases z with ⟨_ | _ | o, v⟩ <;> rfl -theorem forgetEnvMBO_fst (z : Σ p, dIn (withMBO V) p) : (forgetEnvMBO z).1 = z.1 := by +lemma forgetEnvMBO_fst (z : Σ p, dIn (withMBO V) p) : (forgetEnvMBO z).1 = z.1 := by -- By cases on the port: forgetting the MBO keeps the port. rcases z with ⟨_ | _ | o, v⟩ <;> rfl -@[simp] theorem tagDecision_tagDecision (b c : Bool) (z : Σ p, dOut U p) : +@[simp] lemma tagDecision_tagDecision (b c : Bool) (z : Σ p, dOut U p) : tagDecision b (tagDecision c z) = tagDecision b z := by -- By cases on the port: only the last replacement of the decision counts. rcases z with ⟨_ | _ | o, v⟩ <;> rfl /-- An output whose decision, if any, is `b` is unchanged by deciding `b`. -/ -theorem tagDecision_eq_self {z : Σ p, dOut U p} {b : Bool} +lemma tagDecision_eq_self {z : Σ p, dOut U p} {b : Bool} (hz : ∀ c, decisionBit z = some c → c = b) : tagDecision b z = z := by -- Only a decision changes, and a decision is already `b`. rcases z with ⟨_ | _ | o, v⟩ @@ -1603,13 +1603,13 @@ theorem tagDecision_eq_self {z : Σ p, dOut U p} {b : Bool} rfl · rfl -theorem map_forgetEnvMBO_dHist (ys : List (Σ o, withMBO V o)) : +lemma map_forgetEnvMBO_dHist (ys : List (Σ o, withMBO V o)) : (dHist ys).map forgetEnvMBO = dHist (ys.map forgetMBO) := by -- `dHist` is the trigger followed by the replies; forgetting MBOs maps each reply. simp only [dHist, List.map_cons, List.map_map] rfl -theorem latestBy_envMBO_dHist (ys : List (Σ o, withMBO V o)) : +lemma latestBy_envMBO_dHist (ys : List (Σ o, withMBO V o)) : latestBy envMBO (dHist ys) = ((ys.getLast?).map fun y => y.2.2).getD false := by -- Induction from the right: the trigger carries no MBO, and the MBO of each new reply becomes -- the latest. @@ -1625,10 +1625,10 @@ and decides the MBO of the latest reply. -/ def DDD.winner (D : DDD O U V) : DDD O U (withMBO V) := fun h => (D (h.map forgetEnvMBO)).map (tagDecision (latestBy envMBO h)) -theorem DDD.winner_dom (D : DDD O U V) (h) : +lemma DDD.winner_dom (D : DDD O U V) (h) : (D.winner h).Dom ↔ (D (h.map forgetEnvMBO)).Dom := Iff.rfl -theorem DDD.relabel_winner (D : DDD O U V) : +lemma DDD.relabel_winner (D : DDD O U V) : relabel D.winner id (tagDecision false) = relabel D forgetEnvMBO (tagDecision false) := by -- With every decision replaced by `false`, what the winner decides is erased, leaving `D` on -- the replies without MBOs. @@ -1639,7 +1639,7 @@ theorem DDD.relabel_winner (D : DDD O U V) : funext z simp -theorem DDD.reach_winner_iff (D : DDD O U V) (h) : +lemma DDD.reach_winner_iff (D : DDD O U V) (h) : Reach D.winner h ↔ Reach D (h.map forgetEnvMBO) := by -- Compare with `D` relabeled on its inputs, which reaches `h` iff `D` reaches `h` without MBOs. -- Reaching asks for a defined reply at every nonempty prefix, and the winner replies exactly @@ -1651,7 +1651,7 @@ theorem DDD.reach_winner_iff (D : DDD O U V) (h) : rw [reach_snoc_iff, ih, reach_snoc_iff] simp [DDD.winner, relabel] -theorem DDD.replyLabel_winner (D : DDD O U V) (h) : +lemma DDD.replyLabel_winner (D : DDD O U V) (h) : replyLabel D.winner h = replyLabel D (h.map forgetEnvMBO) := by -- The winner replies exactly when `D` does on the replies without MBOs, and replacing the -- decision keeps the port. @@ -1664,7 +1664,7 @@ theorem DDD.replyLabel_winner (D : DDD O U V) (h) : · rw [dif_neg hd, dif_neg (fun h' => hd ((D.winner_dom h).mp h'))] /-- The winner of a deterministic distinguisher is a deterministic distinguisher. -/ -theorem IsDDD.winner {D : DDD O U V} (hD : IsDDD D) : IsDDD D.winner := by +lemma IsDDD.winner {D : DDD O U V} (hD : IsDDD D) : IsDDD D.winner := by -- Each condition on the winner at a history is the condition on `D` at the history without -- MBOs: the same domain (`winner_dom`), reaching (`reach_winner_iff`) and reply ports -- (`replyLabel_winner`); forgetting MBOs keeps the ports of inputs. @@ -1688,7 +1688,7 @@ theorem IsDDD.winner {D : DDD O U V} (hD : IsDDD D) : IsDDD D.winner := by (by simpa only [List.map_append, List.map_singleton] using (D.reach_winner_iff _).mp hr) open scoped Classical in -theorem DDD.trim_winner (D : DDD O U V) : trim D.winner = DDD.winner (trim D) := by +lemma DDD.trim_winner (D : DDD O U V) : trim D.winner = DDD.winner (trim D) := by -- `trim` keeps the outputs at reachable histories, and the winner reaches exactly where `D` -- reaches on the replies without MBOs; the decision replacement passes through the `if`. funext h @@ -1696,7 +1696,7 @@ theorem DDD.trim_winner (D : DDD O U V) : trim D.winner = DDD.winner (trim D) := split_ifs <;> simp /-- The winner queries as the distinguisher on the replies without their MBO. -/ -theorem DDD.envOf_trim_winner (D : DDD O U V) (ys : List (Σ o, withMBO V o)) : +lemma DDD.envOf_trim_winner (D : DDD O U V) (ys : List (Σ o, withMBO V o)) : envOf (trim D.winner) ys = envOf (trim D) (ys.map forgetMBO) := by -- The environment of a distinguisher reads only its queries. The history of the winner is that -- of `D` with the MBOs forgotten (`map_forgetEnvMBO_dHist`). @@ -1713,7 +1713,7 @@ variable [Fintype O] [∀ o, Fintype (U o)] [∀ o, Fintype (V o)] /-- **Winning is deciding with the winner**: the winning probability of a compatible distinguisher is the decision probability of its winner. -/ -theorem RandomSystem.winProbability_eq_decisionProbability_winner (D : DDD O U V) (hD : IsDDD D) +lemma RandomSystem.winProbability_eq_decisionProbability_winner (D : DDD O U V) (hD : IsDDD D) (hc : (Domain.ofInputs F n hF : Domain (Σ o, U o) (Σ o, V o)).DecisionCompatible D) {R : RandomSystem (Σ o, U o) (Σ o, withMBO V o) (Domain.ofInputs F n hF)} (hR : R.RepliesAtQueriedInterface) : @@ -1806,7 +1806,7 @@ variable {O J : Type} {U V : O → Type} {X Y : J → Type} /-- **Bits through the absorption of a lift into a winner**: the lift's outside replies carry their tags to the winner, its inside queries leave untagged, and the winner's queries carry no bit. -/ -theorem tagRouting_absorbAll (a : InsideOutsideSystem O J U V X Y) : +lemma tagRouting_absorbAll (a : InsideOutsideSystem O J U V X Y) : TagRouting (envMBO (V := V)) (inputMBO (U := U) (Y := Y)) (envMBO (V := Y)) (outputMBO (V := V) (X := X)) (liftMBO a) (absorptionRoute (U := U) (V := withMBO V) (X := X) (Y := withMBO Y)) @@ -1864,7 +1864,7 @@ theorem tagRouting_absorbAll (a : InsideOutsideSystem O J U V X Y) : /-- **The decision of a winner with a lift absorbed is the latest MBO**: when the winner decides, the lift is idle and its latest reply carried its latest inside MBO to the winner. -/ -theorem decisionBit_absorbAll_winner {b : ℕ} {D : DDD O U V} (hD : IsDDD D) +lemma decisionBit_absorbAll_winner {b : ℕ} {D : DDD O U V} (hD : IsDDD D) {a : InsideOutsideSystem O J U V X Y} (ha : IsDDC b a) {u w c} (hr : Reach (absorbAll D.winner (liftMBO a)) u) (hw : w ∈ absorbAll D.winner (liftMBO a) u) (hc : decisionBit w = some c) : c = latestBy envMBO u := by @@ -1936,7 +1936,7 @@ theorem decisionBit_absorbAll_winner {b : ℕ} {D : DDD O U V} (hD : IsDDD D) /-- **A winner with a lift absorbed, without its decision**, is the distinguisher with the converter absorbed, on the replies without their MBO. -/ -theorem relabel_absorbAll_winner (D : DDD O U V) (a : InsideOutsideSystem O J U V X Y) : +lemma relabel_absorbAll_winner (D : DDD O U V) (a : InsideOutsideSystem O J U V X Y) : relabel (absorbAll D.winner (liftMBO a)) id (tagDecision false) = relabel (absorbAll D a) forgetEnvMBO (tagDecision false) := by -- Move the relabelings through the interconnection, one component at a time: @@ -1993,7 +1993,7 @@ theorem relabel_absorbAll_winner (D : DDD O U V) (a : InsideOutsideSystem O J U rcases u with ⟨_ | _ | j, v⟩ <;> first | exact v.elim | rfl /-- **Absorbing a lift into a winner gives the winner of the absorbed distinguisher.** -/ -theorem trim_absorbAll_winner {b : ℕ} {D : DDD O U V} (hD : IsDDD D) +lemma trim_absorbAll_winner {b : ℕ} {D : DDD O U V} (hD : IsDDD D) {a : InsideOutsideSystem O J U V X Y} (ha : IsDDC b a) : trim (absorbAll D.winner (liftMBO a)) = DDD.winner (trim (absorbAll D a)) := by -- The winner with the lift absorbed: @@ -2065,7 +2065,7 @@ variable {O J : Type} [Fintype O] [Fintype J] {U V : O → Type} {X Y : J → Ty omit [Fintype J] [∀ j, Fintype (X j)] [∀ j, Fintype (Y j)] in /-- Equal distinguishers have equal decision probabilities, whatever the proofs that they are distinguishers. -/ -theorem RandomSystem.decisionProbability_congr {I : Type} [Fintype I] {X' Y' : I → Type} +lemma RandomSystem.decisionProbability_congr {I : Type} [Fintype I] {X' Y' : I → Type} [∀ i, Fintype (X' i)] [∀ i, Fintype (Y' i)] {𝒟 : Domain (Σ i, X' i) (Σ i, Y' i)} (R : RandomSystem (Σ i, X' i) (Σ i, Y' i) 𝒟) {D₁ D₂ : DDD I X' Y'} (he : D₁ = D₂) (h₁ : IsDDD D₁) (h₂ : IsDDD D₂) : @@ -2076,7 +2076,7 @@ theorem RandomSystem.decisionProbability_congr {I : Type} [Fintype I] {X' Y' : I /-- **Attaching a lift averages the absorbed winning probabilities** over a presentation of the PDC, the step towards CR18, equation (4.9), for a PDC. -/ -theorem RandomSystem.winProbability_attach_liftMBO (D : DDD O U V) (hD : IsDDD D) +lemma RandomSystem.winProbability_attach_liftMBO (D : DDD O U V) (hD : IsDDD D) (hc : (Domain.ofInputs F n hF : Domain (Σ o, U o) (Σ o, V o)).DecisionCompatible D) (α : PDCBehavior O J U V X Y E m hE F n hF) {b : ℕ} (P : Distribution.ProbDist {a : InsideOutsideSystem O J U V X Y // IsDDCFrom E F b a}) diff --git a/src/RandomSystems/Game/UntilBad.lean b/src/RandomSystems/Game/UntilBad.lean index 21f47ce..60bc0cb 100644 --- a/src/RandomSystems/Game/UntilBad.lean +++ b/src/RandomSystems/Game/UntilBad.lean @@ -49,7 +49,7 @@ variable {I : Type} [Fintype I] {X Y : I → Type} [∀ i, Fintype (X i)] [∀ i /-- The part of a game with every MBO unset lies below its visible system: `G (h with every MBO unset)` is one term of the sum over the MBOs. -/ -theorem RandomSystem.mass_unsetMBOs_le_visible +lemma RandomSystem.mass_unsetMBOs_le_visible (G : RandomSystem (Σ i, X i) (Σ i, withMBO Y i) (Domain.ofInputs E m hE)) (h : List ((Σ i, X i) × Σ i, Y i)) : G (unsetMBOs h) ≤ G.visible h := by have := le_sumMBO G.mass_nonneg (unsetMBOs h) @@ -60,7 +60,7 @@ theorem RandomSystem.mass_unsetMBOs_le_visible probability of `h` with every MBO unset minus the probability that `G` sets the MBO at `x`. So if that probability is at most `b` times the probability of `h` with every MBO unset, with `b ≥ 0`, the unset part loses at most `b` times the probability of `h` in the visible system. -/ -theorem RandomSystem.mass_unsetMBOs_sub_sum_le +lemma RandomSystem.mass_unsetMBOs_sub_sum_le (G : RandomSystem (Σ i, X i) (Σ i, withMBO Y i) (Domain.ofInputs E m hE)) {h : List ((Σ i, X i) × Σ i, Y i)} {x : Σ i, X i} (hx : E (h.map Prod.fst ++ [x])) {b : ℝ} (hb : 0 ≤ b) (hset : ∑ y, G (unsetMBOs h ++ [(x, tagMBO true y)]) ≤ b * G (unsetMBOs h)) : diff --git a/src/RandomSystems/PDS/Conditional.lean b/src/RandomSystems/PDS/Conditional.lean index 489c26d..7782234 100644 --- a/src/RandomSystems/PDS/Conditional.lean +++ b/src/RandomSystems/PDS/Conditional.lean @@ -28,16 +28,16 @@ def conditionalHistory (xs : List A) : Part (List (A × B)) := List.reverseRecOn xs (Part.some []) fun _ x prior => prior.bind fun h => (q h x).map fun y => h ++ [(x, y)] -@[simp] theorem conditionalHistory_nil : conditionalHistory q [] = Part.some [] := by +@[simp] lemma conditionalHistory_nil : conditionalHistory q [] = Part.some [] := by simp [conditionalHistory] -theorem conditionalHistory_snoc (xs : List A) (x : A) : +lemma conditionalHistory_snoc (xs : List A) (x : A) : conditionalHistory q (xs ++ [x]) = (conditionalHistory q xs).bind fun h => (q h x).map fun y => h ++ [(x, y)] := by unfold conditionalHistory rw [List.reverseRecOn_concat] -theorem conditionalHistory_queries {xs : List A} {h : List (A × B)} +lemma conditionalHistory_queries {xs : List A} {h : List (A × B)} (hh : h ∈ conditionalHistory q xs) : h.map Prod.fst = xs := by induction xs using List.reverseRecOn generalizing h with | nil => @@ -50,7 +50,7 @@ theorem conditionalHistory_queries {xs : List A} {h : List (A × B)} obtain ⟨y, _, rfl⟩ := hy simpa using congrArg (· ++ [x]) (ih hh') -theorem conditionalHistory_prefix {xs ys : List A} (hp : xs <+: ys) +lemma conditionalHistory_prefix {xs ys : List A} (hp : xs <+: ys) (hd : (conditionalHistory q ys).Dom) : (conditionalHistory q xs).Dom := by obtain ⟨e, rfl⟩ := hp induction e using List.reverseRecOn with @@ -64,10 +64,10 @@ theorem conditionalHistory_prefix {xs ys : List A} (hp : xs <+: ys) def conditionalReply (xs : List A) : Part B := (conditionalHistory q xs).bind fun h => (h.getLast?.map Prod.snd : Part B) -@[simp] theorem conditionalReply_nil : conditionalReply q [] = Part.none := by +@[simp] lemma conditionalReply_nil : conditionalReply q [] = Part.none := by simp [conditionalReply] -theorem conditionalReply_snoc {xs : List A} {h : List (A × B)} +lemma conditionalReply_snoc {xs : List A} {h : List (A × B)} (hh : h ∈ conditionalHistory q xs) (x : A) : conditionalReply q (xs ++ [x]) = q h x := by rw [conditionalReply, conditionalHistory_snoc, Part.eq_some_iff.mpr hh] @@ -76,7 +76,7 @@ theorem conditionalReply_snoc {xs : List A} {h : List (A × B)} intro y simp -theorem conditionalReply_dom {xs : List A} (hn : xs ≠ []) : +lemma conditionalReply_dom {xs : List A} (hn : xs ≠ []) : (conditionalReply q xs).Dom ↔ (conditionalHistory q xs).Dom := by constructor · intro hd @@ -103,7 +103,7 @@ def ofConditional : DDS A B := have hyn : ys ≠ [] := by rintro rfl; simp at hd exact (conditionalReply_dom q hyn).mp hd⟩ -theorem conditionalHistory_replies {xs : List A} {h : List (A × B)} +lemma conditionalHistory_replies {xs : List A} {h : List (A × B)} (hh : h ∈ conditionalHistory q xs) : Replies (ofConditional q).1 (h.map Prod.fst) (h.map Prod.snd) := by induction xs using List.reverseRecOn generalizing h with @@ -122,7 +122,7 @@ theorem conditionalHistory_replies {xs : List A} {h : List (A × B)} rw [conditionalHistory_queries q hh', conditionalReply_snoc q hh'] exact Part.eq_some_iff.mpr hy -theorem replies_conditionalHistory {h : List (A × B)} +lemma replies_conditionalHistory {h : List (A × B)} (hr : Replies (ofConditional q).1 (h.map Prod.fst) (h.map Prod.snd)) : h ∈ conditionalHistory q (h.map Prod.fst) := by induction h using List.reverseRecOn with @@ -138,7 +138,7 @@ theorem replies_conditionalHistory {h : List (A × B)} simp only [Part.mem_map_iff] exact ⟨z.2, Part.eq_some_iff.mp hy, rfl⟩ -theorem ofConditional_snoc {h : List (A × B)} +lemma ofConditional_snoc {h : List (A × B)} (hr : Replies (ofConditional q).1 (h.map Prod.fst) (h.map Prod.snd)) (x : A) : (ofConditional q).1 (h.map Prod.fst ++ [x]) = q h x := conditionalReply_snoc q (replies_conditionalHistory q hr) x diff --git a/src/RandomSystems/PDS/Filter.lean b/src/RandomSystems/PDS/Filter.lean index bc6367d..75ed4e6 100644 --- a/src/RandomSystems/PDS/Filter.lean +++ b/src/RandomSystems/PDS/Filter.lean @@ -29,18 +29,18 @@ noncomputable def filterDom {X Y : Type} (D : List X → Prop) (s : System X Y) : System X Y := fun h => if D h then s h else Part.none -theorem filterDom_dom {X Y : Type} (D : List X → Prop) +lemma filterDom_dom {X Y : Type} (D : List X → Prop) (s : System X Y) (h : List X) : (filterDom D s h).Dom ↔ D h ∧ (s h).Dom := by by_cases hd : D h <;> simp [filterDom, hd, Part.not_none_dom] -theorem filterDom_mem_iff {X Y : Type} (D : List X → Prop) +lemma filterDom_mem_iff {X Y : Type} (D : List X → Prop) (s : System X Y) (h : List X) (y : Y) : y ∈ filterDom D s h ↔ D h ∧ y ∈ s h := by by_cases hd : D h <;> simp [filterDom, hd] /-- Restriction retains the complete behavior at every admitted prefix. -/ -theorem run_filterDom {X Y : Type} (P : Y → Prop) (D : List X → Prop) +lemma run_filterDom {X Y : Type} (P : Y → Prop) (D : List X → Prop) (hD : ∀ {p h}, p <+: h → p ≠ [] → D h → D p) (s : System X Y) {h : List X} (hd : D h) : run P (filterDom D s) h = run P s h := by @@ -55,12 +55,12 @@ theorem run_filterDom {X Y : Type} (P : Y → Prop) (D : List X → Prop) · rw [ih (hD (List.prefix_append _ _) hn hd)] · rfl -theorem filterDom_filterDom {X Y : Type} (D E : List X → Prop) (s : System X Y) : +lemma filterDom_filterDom {X Y : Type} (D E : List X → Prop) (s : System X Y) : filterDom D (filterDom E s) = filterDom (fun h => D h ∧ E h) s := by funext h by_cases hd : D h <;> by_cases he : E h <;> simp [filterDom, hd, he] -theorem IsDDS.filterDom {X Y : Type} {s : System X Y} (hs : IsDDS s) +lemma IsDDS.filterDom {X Y : Type} {s : System X Y} (hs : IsDDS s) (D : List X → Prop) (hD : ∀ {p h}, p <+: h → p ≠ [] → D h → D p) : IsDDS (filterDom D s) := by @@ -77,7 +77,7 @@ noncomputable def filterDom {X Y : Type} (D : List X → Prop) (hD : ∀ {p h}, p <+: h → p ≠ [] → D h → D p) (s : DDS X Y) : DDS X Y := ⟨SystemAlgebra.filterDom D s.1, s.2.filterDom D hD⟩ -theorem filterDom_ofFunction {X Y : Type} (D E : List X → Prop) +lemma filterDom_ofFunction {X Y : Type} (D E : List X → Prop) (hD : ∀ {p h}, p <+: h → p ≠ [] → D h → D p) (hE : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) (f : X → Y) : @@ -98,13 +98,13 @@ def Domain.restrict {X Y : Type} (D : Domain X Y) (F : List X → Prop) : Domain length_lt h x hx := D.length_lt h x hx.2 /-- A restriction answers precisely the transcripts it retains. -/ -theorem replies_filterDom {X Y : Type} (F : List X → Prop) (s : System X Y) {xs ys} : +lemma replies_filterDom {X Y : Type} (F : List X → Prop) (s : System X Y) {xs ys} : Replies (filterDom F s) xs ys → Replies s xs ys := Replies.mono fun h y hy => ((filterDom_mem_iff F s h y).mp hy).2 /-- On a history in a domain closed under nonempty prefixes, the restriction replies as the system. -/ -theorem replies_filterDom_iff {X Y : Type} {F : List X → Prop} +lemma replies_filterDom_iff {X Y : Type} {F : List X → Prop} (hF : ∀ {p h}, p <+: h → p ≠ [] → F h → F p) (s : System X Y) {xs ys} (hx : xs ≠ [] → F xs) : Replies (filterDom F s) xs ys ↔ Replies s xs ys := by @@ -113,7 +113,7 @@ theorem replies_filterDom_iff {X Y : Type} {F : List X → Prop} rw [filterDom, if_pos (hF (List.take_prefix _ _) hne (hx fun he => by simp [he] at hne))] exact hr.2 k hk hk' -theorem HasDomain.filterDom {X Y : Type} {D : Domain X Y} {s : System X Y} +lemma HasDomain.filterDom {X Y : Type} {D : Domain X Y} {s : System X Y} (hs : HasDomain D s) (F : List X → Prop) : HasDomain (D.restrict F) (SystemAlgebra.filterDom F s) := fun h x hr => (filterDom_dom F s _).trans (and_congr_right fun _ => hs h x (replies_filterDom F s hr)) diff --git a/src/RandomSystems/PDS/Function.lean b/src/RandomSystems/PDS/Function.lean index b420cf3..ec9e901 100644 --- a/src/RandomSystems/PDS/Function.lean +++ b/src/RandomSystems/PDS/Function.lean @@ -37,7 +37,7 @@ noncomputable def ofFunction {X Y : Type} (D : List X → Prop) simp [hh] at hd simp [hD.2 hp hn hh, hn]⟩ -theorem ofFunction_dom {X Y : Type} (D : List X → Prop) +lemma ofFunction_dom {X Y : Type} (D : List X → Prop) (hD : ¬ D [] ∧ ∀ {p h}, p <+: h → p ≠ [] → D h → D p) (f : X → Y) (h : List X) : ((ofFunction D hD f).1 h).Dom ↔ D h := by by_cases hd : D h @@ -45,7 +45,7 @@ theorem ofFunction_dom {X Y : Type} (D : List X → Prop) simp [ofFunction, hd, hn] · simp [ofFunction, hd] -theorem ofFunction_snoc {X Y : Type} (D : List X → Prop) +lemma ofFunction_snoc {X Y : Type} (D : List X → Prop) (hD : ¬ D [] ∧ ∀ {p h}, p <+: h → p ≠ [] → D h → D p) (f : X → Y) (xs : List X) (x : X) : (ofFunction D hD f).1 (xs ++ [x]) = @@ -53,7 +53,7 @@ theorem ofFunction_snoc {X Y : Type} (D : List X → Prop) simp [ofFunction] /-- A fixed function's transcript consists precisely of its pointwise replies. -/ -theorem replies_ofFunction_iff {X Y : Type} (D : List X → Prop) +lemma replies_ofFunction_iff {X Y : Type} (D : List X → Prop) (hD : ¬ D [] ∧ ∀ {p h}, p <+: h → p ≠ [] → D h → D p) (f : X → Y) (xs : List X) (ys : List Y) : Replies (ofFunction D hD f).1 xs ys ↔ diff --git a/src/RandomSystems/PDS/PDS.lean b/src/RandomSystems/PDS/PDS.lean index abc9a2b..456201c 100644 --- a/src/RandomSystems/PDS/PDS.lean +++ b/src/RandomSystems/PDS/PDS.lean @@ -36,7 +36,7 @@ noncomputable def behaviorMass {p : System A B → Prop} (P : Distribution {s : System A B // p s}) (xs : List A) (ys : List B) : ℝ := P.mass fun s => Replies s.1 xs ys -theorem behaviorMass_ne_zero {p : System A B → Prop} +lemma behaviorMass_ne_zero {p : System A B → Prop} {P : Distribution {s : System A B // p s}} {xs : List A} {ys : List B} (hm : behaviorMass P xs ys ≠ 0) : ∃ s ∈ P.support, Replies s.1 xs ys := by change (∑ s ∈ P.support, if Replies s.1 xs ys then P s else 0) ≠ 0 at hm @@ -51,12 +51,12 @@ def Equivalent {p : System A B → Prop} (P Q : Distribution {s : System A B // p s}) : Prop := ∀ xs ys, behaviorMass P xs ys = behaviorMass Q xs ys -theorem Equivalent.refl {p : System A B → Prop} +lemma Equivalent.refl {p : System A B → Prop} (P : Distribution {s : System A B // p s}) : Equivalent P P := fun _ _ => rfl -theorem Equivalent.symm {p : System A B → Prop} +lemma Equivalent.symm {p : System A B → Prop} {P Q : Distribution {s : System A B // p s}} (h : Equivalent P Q) : Equivalent Q P := fun xs ys => (h xs ys).symm -theorem Equivalent.trans {p : System A B → Prop} +lemma Equivalent.trans {p : System A B → Prop} {P Q R : Distribution {s : System A B // p s}} (h : Equivalent P Q) (h' : Equivalent Q R) : Equivalent P R := fun xs ys => (h xs ys).trans (h' xs ys) @@ -81,7 +81,7 @@ def Domain.ofInputs (E : List A → Prop) (bound : ℕ) (hE : ∀ h, E h → h.l simp only [List.length_append, List.length_map, List.length_singleton] at this omega -@[simp] theorem Domain.ofInputs_apply (E : List A → Prop) (bound : ℕ) +@[simp] lemma Domain.ofInputs_apply (E : List A → Prop) (bound : ℕ) (hE : ∀ h, E h → h.length ≤ bound) (h : List (A × B)) (x : A) : (Domain.ofInputs E bound hE : Domain A B) h x = E (h.map Prod.fst ++ [x]) := rfl @@ -93,14 +93,14 @@ def HasDomain (D : Domain A B) (s : System A B) : Prop := ((s (h.map Prod.fst ++ [x])).Dom ↔ D h x) /-- A system whose domain is a set of input histories has that input domain. -/ -theorem HasDomain.ofInputs {E : List A → Prop} {bound : ℕ} {hE : ∀ h, E h → h.length ≤ bound} +lemma HasDomain.ofInputs {E : List A → Prop} {bound : ℕ} {hE : ∀ h, E h → h.length ≤ bound} {s : System A B} (hs : ∀ h, (s h).Dom ↔ E h) : HasDomain (Domain.ofInputs E bound hE) s := fun _ _ _ => hs _ /-- **On an input domain, `HasDomain` is `dom(s) = E`** (Lanzenberger–Maurer, Definitions 5 and 8, printed pp. 11, 13), for a DDS and a prefix-closed `E` without the empty history. -/ -theorem hasDomain_ofInputs_iff {E : List A → Prop} {bound : ℕ} +lemma hasDomain_ofInputs_iff {E : List A → Prop} {bound : ℕ} {hE : ∀ h, E h → h.length ≤ bound} (hE' : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) {s : System A B} (hs : IsDDS s) : HasDomain (Domain.ofInputs E bound hE) s ↔ ∀ h, (s h).Dom ↔ E h := by @@ -114,7 +114,7 @@ theorem hasDomain_ofInputs_iff {E : List A → Prop} {bound : ℕ} rwa [hx] at this /-- Transcripts of a system with domain `D` stay within the bound of `D`. -/ -theorem HasDomain.length_le {D : Domain A B} {s : System A B} (hs : HasDomain D s) +lemma HasDomain.length_le {D : Domain A B} {s : System A B} (hs : HasDomain D s) {h : List (A × B)} (hr : Replies s (h.map Prod.fst) (h.map Prod.snd)) : h.length ≤ D.bound := by induction h using List.reverseRecOn with | nil => exact Nat.zero_le _ @@ -146,7 +146,7 @@ noncomputable def nextReply (xs : List A) (ys : List B) (x : A) : Distribution B else 0 /-- Next-reply masses are precisely the extended cumulative masses. -/ -theorem nextReply_apply (xs : List A) (ys : List B) (x : A) (y : B) : +lemma nextReply_apply (xs : List A) (ys : List B) (x : A) (y : B) : nextReply P xs ys x y = behaviorMass P (xs ++ [x]) (ys ++ [y]) := by simp only [nextReply, Finsupp.finsetSum_apply, behaviorMass, Distribution.mass, Finsupp.sum] apply Finset.sum_congr rfl @@ -160,14 +160,14 @@ theorem nextReply_apply (xs : List A) (ys : List B) (x : A) (y : B) : · simp [Part.eq_none_iff'.mpr hd] · simp [hr, replies_snoc] -theorem nextReply_nonneg (hP : P.NonNeg) (xs : List A) (ys : List B) (x : A) : +lemma nextReply_nonneg (hP : P.NonNeg) (xs : List A) (ys : List B) (x : A) : (nextReply P xs ys x).NonNeg := by intro y rw [nextReply_apply] exact hP.mass_nonneg _ /-- The next-reply weight counts precisely the samples answering the extended query. -/ -theorem nextReply_weight (xs : List A) (ys : List B) (x : A) : +lemma nextReply_weight (xs : List A) (ys : List B) (x : A) : (nextReply P xs ys x).weight = P.mass (fun s => Replies s.1 xs ys ∧ (s.1 (xs ++ [x])).Dom) := by rw [nextReply, Distribution.weight_finset_sum] @@ -181,7 +181,7 @@ theorem nextReply_weight (xs : List A) (ys : List B) (x : A) : · simp [hr, Distribution.weight] /-- Partiality removes reply mass, without introducing an artificial reply. -/ -theorem nextReply_weight_le (hP : P.NonNeg) (xs : List A) (ys : List B) (x : A) : +lemma nextReply_weight_le (hP : P.NonNeg) (xs : List A) (ys : List B) (x : A) : (nextReply P xs ys x).weight ≤ behaviorMass P xs ys := by rw [nextReply_weight] exact Distribution.mass_mono hP (fun _ h => h.1) @@ -189,7 +189,7 @@ theorem nextReply_weight_le (hP : P.NonNeg) (xs : List A) (ys : List B) (x : A) /-- On a specified preceding transcript, every sample that produced it admits the same next inputs. This also applies to converters, whose next port depends on the preceding output rather than only on the input sequence. -/ -theorem nextReply_weight_of_admitted {D : Prop} {xs : List A} {ys : List B} {x : A} +lemma nextReply_weight_of_admitted {D : Prop} {xs : List A} {ys : List B} {x : A} (hD : ∀ s ∈ P.support, Replies s.1 xs ys → ((s.1 (xs ++ [x])).Dom ↔ D)) : (nextReply P xs ys x).weight = if D then behaviorMass P xs ys else 0 := by rw [nextReply_weight] @@ -204,7 +204,7 @@ theorem nextReply_weight_of_admitted {D : Prop} {xs : List A} {ys : List B} {x : exact Distribution.mass_eq_zero_of_forall_not _ (fun _ h => h) /-- The empty cumulative mass is the distribution's weight. -/ -theorem behaviorMass_nil : behaviorMass P [] [] = P.weight := by +lemma behaviorMass_nil : behaviorMass P [] [] = P.weight := by rw [behaviorMass, Distribution.mass_congr _ (fun _ => iff_true_intro (replies_nil _))] exact Distribution.mass_true _ diff --git a/src/RandomSystems/System/Automaton.lean b/src/RandomSystems/System/Automaton.lean index c9535b7..90a1d8a 100644 --- a/src/RandomSystems/System/Automaton.lean +++ b/src/RandomSystems/System/Automaton.lean @@ -32,9 +32,9 @@ variable {I S : Type} {X Y : I → Type} (step : S → (i : I) → X i → S × def stateAfter (s : S) (h : List (Σ i, X i)) : S := h.foldl (fun s x => (step s x.1 x.2).1) s -@[simp] theorem stateAfter_nil (s : S) : stateAfter step s [] = s := rfl +@[simp] lemma stateAfter_nil (s : S) : stateAfter step s [] = s := rfl -theorem stateAfter_snoc (s : S) (h : List (Σ i, X i)) (x : Σ i, X i) : +lemma stateAfter_snoc (s : S) (h : List (Σ i, X i)) (x : Σ i, X i) : stateAfter step s (h ++ [x]) = (step (stateAfter step s h) x.1 x.2).1 := by simp [stateAfter] @@ -43,24 +43,24 @@ the state reached by the earlier inputs. -/ def automatonSystem (s : S) : InterfaceSystem I X Y := fun h => Part.ofOption (h.getLast?.map fun x => ⟨x.1, (step (stateAfter step s h.dropLast) x.1 x.2).2⟩) -@[simp] theorem automatonSystem_nil (s : S) : automatonSystem step s [] = Part.none := rfl +@[simp] lemma automatonSystem_nil (s : S) : automatonSystem step s [] = Part.none := rfl -theorem automatonSystem_snoc (s : S) (h : List (Σ i, X i)) (x : Σ i, X i) : +lemma automatonSystem_snoc (s : S) (h : List (Σ i, X i)) (x : Σ i, X i) : automatonSystem step s (h ++ [x]) = Part.some ⟨x.1, (step (stateAfter step s h) x.1 x.2).2⟩ := by simp [automatonSystem] -theorem automatonSystem_dom (s : S) (h : List (Σ i, X i)) : +lemma automatonSystem_dom (s : S) (h : List (Σ i, X i)) : (automatonSystem step s h).Dom ↔ h ≠ [] := by rcases List.eq_nil_or_concat h with rfl | ⟨h, x, rfl⟩ · simp · simp [automatonSystem_snoc] -theorem automatonSystem_isDDS (s : S) : IsDDS (automatonSystem step s) := by +lemma automatonSystem_isDDS (s : S) : IsDDS (automatonSystem step s) := by refine ⟨by simp [SilentAtEmpty], fun p h _ hn _ => ?_⟩ rw [automatonSystem_dom] exact hn -theorem automatonSystem_replies (s : S) : RepliesAtQueriedInterface (automatonSystem step s) := by +lemma automatonSystem_replies (s : S) : RepliesAtQueriedInterface (automatonSystem step s) := by intro h x y hy rw [automatonSystem_snoc] at hy exact congrArg Sigma.fst (Part.mem_some_iff.mp hy) @@ -71,7 +71,7 @@ def IsBisim {S' : Type} (step' : S' → (i : I) → X i → S' × Y i) (rel : S ∀ a a' i x, rel a a' → (step a i x).2 = (step' a' i x).2 ∧ rel (step a i x).1 (step' a' i x).1 /-- Bisimulations compose. -/ -theorem IsBisim.comp {S' S'' : Type} {step' : S' → (i : I) → X i → S' × Y i} +lemma IsBisim.comp {S' S'' : Type} {step' : S' → (i : I) → X i → S' × Y i} {step'' : S'' → (i : I) → X i → S'' × Y i} {rel : S → S' → Prop} {rel' : S' → S'' → Prop} (h : IsBisim step step' rel) (h' : IsBisim step' step'' rel') : IsBisim step step'' (fun a a'' => ∃ a', rel a a' ∧ rel' a' a'') := by @@ -81,7 +81,7 @@ theorem IsBisim.comp {S' S'' : Type} {step' : S' → (i : I) → X i → S' × Y exact ⟨h₁.trans h₁', _, h₂, h₂'⟩ /-- Equality is a bisimulation of an automaton with itself. -/ -theorem isBisim_eq : IsBisim step step (fun a a' => a = a') := by +lemma isBisim_eq : IsBisim step step (fun a a' => a = a') := by rintro a a' i x rfl exact ⟨rfl, rfl⟩ diff --git a/src/RandomSystems/System/Basic.lean b/src/RandomSystems/System/Basic.lean index 709cc7d..ba6e060 100644 --- a/src/RandomSystems/System/Basic.lean +++ b/src/RandomSystems/System/Basic.lean @@ -47,19 +47,19 @@ variable {A B C D E X Y M N : Type} def relabel (s : System X Y) (f : A → X) (g : Y → B) : System A B := fun h => (s (h.map f)).map g -theorem relabel_relabel (s : System X Y) (f : A → X) (g : Y → B) +lemma relabel_relabel (s : System X Y) (f : A → X) (g : Y → B) (f' : C → A) (g' : B → D) : relabel (relabel s f g) f' g' = relabel s (f ∘ f') (g' ∘ g) := by funext h simp [relabel, List.map_map, Part.map_map] -theorem relabel_id (s : System X Y) : relabel s id id = s := by +lemma relabel_id (s : System X Y) : relabel s id id = s := by funext h simp [relabel] exact Part.map_id' (fun _ => rfl) _ /-- Two systems are equal once their replies have the same members. -/ -theorem system_ext {s t : System A B} (h : ∀ u b, b ∈ s u ↔ b ∈ t u) : s = t := by +lemma system_ext {s t : System A B} (h : ∀ u b, b ∈ s u ↔ b ∈ t u) : s = t := by funext u exact Part.ext (h u) @@ -87,14 +87,14 @@ def Terminating (s : System X Y) : Prop := ∃ μ : List X → ℕ, ∀ h x, (s (h ++ [x])).Dom → μ (h ++ [x]) < μ h /-- T0. -/ -theorem Finite.terminating {n : ℕ} {s : System X Y} (hs : Finite n s) : Terminating s := +lemma Finite.terminating {n : ℕ} {s : System X Y} (hs : Finite n s) : Terminating s := ⟨fun h => n - h.length, fun h x hd => by have := hs _ hd simp at this ⊢ omega⟩ /-- T3. -/ -theorem Terminating.relabel {s : System X Y} (hs : Terminating s) (f : A → X) (g : Y → B) : +lemma Terminating.relabel {s : System X Y} (hs : Terminating s) (f : A → X) (g : Y → B) : Terminating (SystemAlgebra.relabel s f g) := by obtain ⟨μ, hμ⟩ := hs exact ⟨fun h => μ (h.map f), fun h x hd => by simpa using hμ (h.map f) (f x) (by simpa [SystemAlgebra.relabel] using hd)⟩ @@ -107,7 +107,7 @@ def Reach (s : System X Y) (h : List X) : Prop := noncomputable def trim (s : System X Y) : System X Y := fun h => if Reach s h then s h else Part.none -theorem trim_eq_of_prefix_eq {s t : System X Y} {h : List X} +lemma trim_eq_of_prefix_eq {s t : System X Y} {h : List X} (he : ∀ p, p <+: h → s p = t p) : trim s h = trim t h := by have hr : Reach s h ↔ Reach t h := by constructor <;> intro hp p e hh hn @@ -144,7 +144,7 @@ inductive Induces : List A → Option B → List X → Prop variable {s route inj} -theorem Exchange.det {h o₁ H₁ o₂ H₂} (l₁ : Exchange s route h o₁ H₁) (l₂ : Exchange s route h o₂ H₂) : +lemma Exchange.det {h o₁ H₁ o₂ H₂} (l₁ : Exchange s route h o₁ H₁) (l₂ : Exchange s route h o₂ H₂) : o₁ = o₂ ∧ H₁ = H₂ := by induction l₁ generalizing o₂ H₂ with | silent h hd => @@ -181,7 +181,7 @@ theorem Exchange.det {h o₁ H₁ o₂ H₂} (l₁ : Exchange s route h o₁ H cases hr' exact ih l -theorem Induces.inv {u o H} (r : Induces s route inj u o H) : +lemma Induces.inv {u o H} (r : Induces s route inj u o H) : (u = [] ∧ o = none ∧ H = []) ∨ ∃ u' a o₀ H₀, u = u' ++ [a] ∧ Induces s route inj u' o₀ H₀ ∧ Exchange s route (H₀ ++ [inj a]) o H := by @@ -189,7 +189,7 @@ theorem Induces.inv {u o H} (r : Induces s route inj u o H) : | nil => exact Or.inl ⟨rfl, rfl, rfl⟩ | snoc u' a o₀ H₀ _ _ r l => exact Or.inr ⟨u', a, o₀, H₀, rfl, r, l⟩ -theorem induces_nil_iff {o H} : Induces s route inj [] o H ↔ o = none ∧ H = [] := by +lemma induces_nil_iff {o H} : Induces s route inj [] o H ↔ o = none ∧ H = [] := by constructor · intro r rcases r.inv with ⟨-, h⟩ | ⟨u', a, _, _, hu, _, _⟩ @@ -197,7 +197,7 @@ theorem induces_nil_iff {o H} : Induces s route inj [] o H ↔ o = none ∧ H = · simp at hu · rintro ⟨rfl, rfl⟩; exact Induces.nil -theorem induces_snoc_iff {u a o H'} : +lemma induces_snoc_iff {u a o H'} : Induces s route inj (u ++ [a]) o H' ↔ ∃ o₀ H, Induces s route inj u o₀ H ∧ Exchange s route (H ++ [inj a]) o H' := by constructor @@ -210,7 +210,7 @@ theorem induces_snoc_iff {u a o H'} : · rintro ⟨o₀, H, r, l⟩ exact Induces.snoc _ _ _ _ _ _ r l -theorem Induces.det {u o₁ H₁ o₂ H₂} (r₁ : Induces s route inj u o₁ H₁) +lemma Induces.det {u o₁ H₁ o₂ H₂} (r₁ : Induces s route inj u o₁ H₁) (r₂ : Induces s route inj u o₂ H₂) : o₁ = o₂ ∧ H₁ = H₂ := by induction r₁ generalizing o₂ H₂ with | nil => obtain ⟨rfl, rfl⟩ := induces_nil_iff.mp r₂; exact ⟨rfl, rfl⟩ @@ -227,7 +227,7 @@ noncomputable def interconnect : System A B := fun u => variable {s route inj} -theorem mem_interconnect {u b} : b ∈ interconnect s route inj u ↔ ∃ H, Induces s route inj u (some b) H := by +lemma mem_interconnect {u b} : b ∈ interconnect s route inj u ↔ ∃ H, Induces s route inj u (some b) H := by constructor · rintro ⟨h, rfl⟩ exact Classical.choose_spec h @@ -242,7 +242,7 @@ section Basic variable {s : System X Y} {route : Y → B ⊕ X} {inj : A → X} -theorem Exchange.extends {h o h'} (l : Exchange s route h o h') : ∃ e, h' = h ++ e := by +lemma Exchange.extends {h o h'} (l : Exchange s route h o h') : ∃ e, h' = h ++ e := by induction l with | silent => exact ⟨[], by simp⟩ | out => exact ⟨[], by simp⟩ @@ -250,7 +250,7 @@ theorem Exchange.extends {h o h'} (l : Exchange s route h o h') : ∃ e, h' = h obtain ⟨e, rfl⟩ := ih exact ⟨x :: e, by simp⟩ -theorem Induces.prefix {u e o H} (r : Induces s route inj (u ++ e) o H) : +lemma Induces.prefix {u e o H} (r : Induces s route inj (u ++ e) o H) : ∃ o' H', Induces s route inj u o' H' := by induction e using List.reverseRecOn generalizing o H with | nil => exact ⟨o, H, by simpa using r⟩ @@ -259,25 +259,25 @@ theorem Induces.prefix {u e o H} (r : Induces s route inj (u ++ e) o H) : obtain ⟨o₀, H₀, r₀, -⟩ := induces_snoc_iff.mp r exact ih r₀ -theorem mem_of_induces_some {u b H} (r : Induces s route inj u (some b) H) : +lemma mem_of_induces_some {u b H} (r : Induces s route inj u (some b) H) : b ∈ interconnect s route inj u := mem_interconnect.mpr ⟨H, r⟩ -theorem not_dom_of_induces_none {u H} (r : Induces s route inj u none H) : +lemma not_dom_of_induces_none {u H} (r : Induces s route inj u none H) : ¬ (interconnect s route inj u).Dom := by intro d obtain ⟨H', r'⟩ := mem_interconnect.mp (Part.get_mem d) cases (r.det r').1 -theorem interconnect_eq_some {u b H} (r : Induces s route inj u (some b) H) : +lemma interconnect_eq_some {u b H} (r : Induces s route inj u (some b) H) : interconnect s route inj u = Part.some b := Part.eq_some_iff.mpr (mem_of_induces_some r) -theorem interconnect_eq_none {u H} (r : Induces s route inj u none H) : +lemma interconnect_eq_none {u H} (r : Induces s route inj u none H) : interconnect s route inj u = Part.none := Part.eq_none_iff'.mpr (not_dom_of_induces_none r) /-- An exchange uses only the system values on its actual input prefixes. -/ -theorem Exchange.congr_of_prefix_eq {t : System X Y} {G o H} +lemma Exchange.congr_of_prefix_eq {t : System X Y} {G o H} (l : Exchange s route G o H) (he : ∀ p, p <+: H → s p = t p) : Exchange t route G o H := by induction l with @@ -289,7 +289,7 @@ theorem Exchange.congr_of_prefix_eq {t : System X Y} {G o H} exact Exchange.feed G y x o H (by rwa [← he G ⟨x :: e, by rw [hH]; simp⟩]) hr (ih he) -theorem Induces.congr_of_prefix_eq {t : System X Y} {u o H} +lemma Induces.congr_of_prefix_eq {t : System X Y} {u o H} (r : Induces s route inj u o H) (he : ∀ p, p <+: H → s p = t p) : Induces t route inj u o H := by induction r with @@ -301,7 +301,7 @@ theorem Induces.congr_of_prefix_eq {t : System X Y} {u o H} (l.congr_of_prefix_eq he) /-- Prefixes of the exposed history keep prefixes of the same component history. -/ -theorem Induces.prefix_history {u e o H} (r : Induces s route inj (u ++ e) o H) : +lemma Induces.prefix_history {u e o H} (r : Induces s route inj (u ++ e) o H) : ∃ o' H', Induces s route inj u o' H' ∧ H' <+: H := by induction e using List.reverseRecOn generalizing o H with | nil => exact ⟨o, H, by simpa using r, List.prefix_refl H⟩ @@ -313,7 +313,7 @@ theorem Induces.prefix_history {u e o H} (r : Induces s route inj (u ++ e) o H) exact ⟨o', H', r', hp.trans ⟨inj a :: e', by rw [he']; simp⟩⟩ /-- Finite component agreement determines every observed prefix, including silence. -/ -theorem Induces.interconnect_eq_on_prefixes {t : System X Y} {u o H} +lemma Induces.interconnect_eq_on_prefixes {t : System X Y} {u o H} (r : Induces s route inj u o H) (he : ∀ p, p <+: H → s p = t p) : ∀ p, p <+: u → interconnect s route inj p = interconnect t route inj p := by rintro p ⟨e, rfl⟩ @@ -328,7 +328,7 @@ def Converges (s : System X Y) (route : Y → B ⊕ X) (inj : A → X) : Prop := ∀ u, ∃ o H, Induces s route inj u o H /-- If every internal exchange stops, the wiring converges. -/ -theorem converges_of_exchanges (h : ∀ H, ∃ o H', Exchange s route H o H') : +lemma converges_of_exchanges (h : ∀ H, ∃ o H', Exchange s route H o H') : ∀ u, ∃ o H, Induces s route inj u o H := by intro u induction u using List.reverseRecOn with @@ -369,7 +369,7 @@ def Cont (o₁ : Option M) (T : List X) (o : Option B) (T' : List X) : Prop := (∃ b, r₂ m = Sum.inl b ∧ o = some b ∧ T' = T) ∨ (∃ n, r₂ m = Sum.inr n ∧ Exchange s RJ (T ++ [i₁ n]) o T') -theorem joint_of_inner {T₀ o₁ T₁ o T'} (l : Exchange s r₁ T₀ o₁ T₁) +lemma joint_of_inner {T₀ o₁ T₁ o T'} (l : Exchange s r₁ T₀ o₁ T₁) (c : Cont (s := s) (r₁ := r₁) (i₁ := i₁) (r₂ := r₂) o₁ T₁ o T') : Exchange s RJ T₀ o T' := by induction l with | silent h hd => @@ -386,7 +386,7 @@ theorem joint_of_inner {T₀ o₁ T₁ o T'} (l : Exchange s r₁ T₀ o₁ T₁ def Pending (K : List N) (T₀ : List X) : Prop := ∀ o₂ T₂, Induces s r₁ i₁ K o₂ T₂ ↔ Exchange s r₁ T₀ o₂ T₂ -theorem pending_snoc {K o T n} (r : Induces s r₁ i₁ K o T) : +lemma pending_snoc {K o T n} (r : Induces s r₁ i₁ K o T) : Pending (s := s) (r₁ := r₁) (i₁ := i₁) (K ++ [n]) (T ++ [i₁ n]) := by intro o₂ T₂ rw [induces_snoc_iff] @@ -397,7 +397,7 @@ theorem pending_snoc {K o T n} (r : Induces s r₁ i₁ K o T) : · intro l exact ⟨o, T, r, l⟩ -theorem pending_feed {K T₀ y x} (p : Pending (s := s) (r₁ := r₁) (i₁ := i₁) K T₀) +lemma pending_feed {K T₀ y x} (p : Pending (s := s) (r₁ := r₁) (i₁ := i₁) K T₀) (hy : y ∈ s T₀) (hr : r₁ y = Sum.inr x) : Pending (s := s) (r₁ := r₁) (i₁ := i₁) K (T₀ ++ [x]) := by intro o₂ T₂ @@ -412,7 +412,7 @@ theorem pending_feed {K T₀ y x} (p : Pending (s := s) (r₁ := r₁) (i₁ := rw [Part.mem_unique hy hy', hr'] at hr; cases hr; exact l · exact Exchange.feed _ y x _ _ hy hr -theorem outer_of_joint {T₀ o T'} (l : Exchange s RJ T₀ o T') : +lemma outer_of_joint {T₀ o T'} (l : Exchange s RJ T₀ o T') : ∀ K, Pending (s := s) (r₁ := r₁) (i₁ := i₁) K T₀ → ∃ K', Exchange F r₂ K o K' ∧ ∃ o₁, Induces s r₁ i₁ K' o₁ T' := by induction l with @@ -447,7 +447,7 @@ theorem outer_of_joint {T₀ o T'} (l : Exchange s RJ T₀ o T') : obtain ⟨K', l', rest⟩ := ih (K ++ [n]) (pending_snoc r) exact ⟨K', Exchange.feed _ m n _ _ (mem_of_induces_some r) hn l', rest⟩ -theorem joint_of_outer {K o K'} (l : Exchange F r₂ K o K') : +lemma joint_of_outer {K o K'} (l : Exchange F r₂ K o K') : ∀ T₀, Pending (s := s) (r₁ := r₁) (i₁ := i₁) K T₀ → ∀ o₁ T', Induces s r₁ i₁ K' o₁ T' → Exchange s RJ T₀ o T' := by induction l with @@ -467,7 +467,7 @@ theorem joint_of_outer {K o K'} (l : Exchange F r₂ K o K') : exact joint_of_inner ((p _ _).mp r₁') (Or.inr ⟨n, hn, ih _ (pending_snoc r₁') o₁ T' r⟩) -theorem induces_joint_iff {u o T} : +lemma induces_joint_iff {u o T} : Induces s RJ (i₁ ∘ i₂) u o T ↔ ∃ K, Induces F r₂ i₂ u o K ∧ ∃ o₁, Induces s r₁ i₁ K o₁ T := by induction u using List.reverseRecOn generalizing o T with @@ -534,7 +534,7 @@ section Naturality variable (s : System X Y) (route : Y → B ⊕ X) (inj : A → X) /-- Relabeling the exposed side of a wired system relabels its routing table. -/ -theorem relabel_interconnect {A' B' : Type} (f : A' → A) (g : B → B') : +lemma relabel_interconnect {A' B' : Type} (f : A' → A) (g : B → B') : relabel (interconnect s route inj) f g = interconnect s (fun y => (route y).map g id) (inj ∘ f) := by have hl : ∀ {h o h'}, Exchange s route h o h' → Exchange s (fun y => (route y).map g id) h (o.map g) h' := by @@ -600,7 +600,7 @@ theorem relabel_interconnect {A' B' : Type} (f : A' → A) (g : B → B') : | some b => cases e; exact ⟨b, ⟨H, r'⟩, rfl⟩ /-- An induced history of a relabeled system maps to one of the system itself. -/ -theorem induces_relabel {X' Y' : Type} {s : System X Y} {f : X' → X} {g : Y → Y'} +lemma induces_relabel {X' Y' : Type} {s : System X Y} {f : X' → X} {g : Y → Y'} {route : Y' → B ⊕ X'} {inj : A → X'} {u o H} (r : Induces (relabel s f g) route inj u o H) : Induces s (fun y => (route (g y)).map id f) (f ∘ inj) u o (H.map f) := by @@ -623,14 +623,14 @@ theorem induces_relabel {X' Y' : Type} {s : System X Y} {f : X' → X} {g : Y obtain ⟨o₀, H₀, r₀, l⟩ := induces_snoc_iff.mp r exact Induces.snoc _ _ _ _ _ _ (ih r₀) (by simpa using hl l) -theorem Converges.relabel {X' Y' : Type} {s : System X Y} {f : X' → X} {g : Y → Y'} +lemma Converges.relabel {X' Y' : Type} {s : System X Y} {f : X' → X} {g : Y → Y'} {route : Y' → B ⊕ X'} {inj : A → X'} (hc : Converges (SystemAlgebra.relabel s f g) route inj) : Converges s (fun y => (route (g y)).map id f) (f ∘ inj) := fun u => by obtain ⟨o, H, r⟩ := hc u exact ⟨o, _, induces_relabel r⟩ /-- Relabeling the inside of a wired system is absorbed by the routing table. -/ -theorem interconnect_relabel {X' Y' : Type} (s : System X Y) (f : X' → X) (g : Y → Y') +lemma interconnect_relabel {X' Y' : Type} (s : System X Y) (f : X' → X) (g : Y → Y') (route : Y' → B ⊕ X') (inj : A → X') : interconnect (relabel s f g) route inj = interconnect s (fun y => (route (g y)).map id f) (f ∘ inj) := by @@ -711,7 +711,7 @@ section NoFeedback variable {s : System X Y} {route : Y → B ⊕ X} {inj : A → X} {g : Y → B} /-- A routing that feeds nothing back: the wiring is a relabeling. -/ -theorem interconnect_no_feedback (hs : SilentAtEmpty s) (hr : ∀ y, route y = .inl (g y)) : +lemma interconnect_no_feedback (hs : SilentAtEmpty s) (hr : ∀ y, route y = .inl (g y)) : interconnect s route inj = relabel s inj g := by have ex : ∀ H, ∃ o, Exchange s route H o H := by intro H @@ -760,7 +760,7 @@ section Termination variable {s : System X Y} {route : Y → B ⊕ X} /-- Exchanges stop when every continued feedback step decreases a measure. -/ -theorem exchanges_of_measure (μ : List X → ℕ) +lemma exchanges_of_measure (μ : List X → ℕ) (hμ : ∀ H y x, y ∈ s H → route y = Sum.inr x → (s (H ++ [x])).Dom → μ (H ++ [x]) < μ H) (H : List X) : ∃ o H', Exchange s route H o H' := by induction h : μ H using Nat.strong_induction_on generalizing H with @@ -777,7 +777,7 @@ theorem exchanges_of_measure (μ : List X → ℕ) · exact ⟨none, H, Exchange.silent _ hd⟩ /-- T2 (first half): the internal exchanges of a terminating system stop. -/ -theorem Terminating.converges {s : System X Y} (hs : Terminating s) (route : Y → B ⊕ X) +lemma Terminating.converges {s : System X Y} (hs : Terminating s) (route : Y → B ⊕ X) (inj : A → X) : Converges s route inj := by obtain ⟨μ, hμ⟩ := hs exact converges_of_exchanges (exchanges_of_measure μ (fun H y x _ _ hd => hμ H x hd)) @@ -795,17 +795,17 @@ noncomputable def restrict (k : K) : List (Σ k, A k) → List (A k) | [] => [] | x :: h => if e : x.1 = k then (e ▸ x.2) :: restrict k h else restrict k h -@[simp] theorem restrict_nil (k : K) : restrict k ([] : List (Σ k, A k)) = [] := rfl +@[simp] lemma restrict_nil (k : K) : restrict k ([] : List (Σ k, A k)) = [] := rfl -@[simp] theorem restrict_cons_self (k : K) (a : A k) (h : List (Σ k, A k)) : +@[simp] lemma restrict_cons_self (k : K) (a : A k) (h : List (Σ k, A k)) : restrict k (⟨k, a⟩ :: h) = a :: restrict k h := by simp [restrict] -@[simp] theorem restrict_cons_ne {k k' : K} (hk : k' ≠ k) (a : A k') (h : List (Σ k, A k)) : +@[simp] lemma restrict_cons_ne {k k' : K} (hk : k' ≠ k) (a : A k') (h : List (Σ k, A k)) : restrict k (⟨k', a⟩ :: h) = restrict k h := by simp [restrict, hk] -@[simp] theorem restrict_append (k : K) (h h' : List (Σ k, A k)) : +@[simp] lemma restrict_append (k : K) (h h' : List (Σ k, A k)) : restrict k (h ++ h') = restrict k h ++ restrict k h' := by induction h with | nil => rfl @@ -815,7 +815,7 @@ noncomputable def restrict (k : K) : List (Σ k, A k) → List (A k) · subst hk; simp [ih] · simp [hk, ih] -theorem length_restrict_le (k : K) (h : List (Σ k, A k)) : (restrict k h).length ≤ h.length := by +lemma length_restrict_le (k : K) (h : List (Σ k, A k)) : (restrict k h).length ≤ h.length := by induction h with | nil => simp | cons x h ih => @@ -824,7 +824,7 @@ theorem length_restrict_le (k : K) (h : List (Σ k, A k)) : (restrict k h).lengt · subst hk; simpa using ih · simpa [hk] using ih.trans (Nat.le_succ _) -theorem length_restrict_singleton (k : K) (x : Σ k, A k) : +lemma length_restrict_singleton (k : K) (x : Σ k, A k) : (restrict k [x]).length = if x.1 = k then 1 else 0 := by obtain ⟨k', a⟩ := x by_cases hk : k' = k @@ -832,7 +832,7 @@ theorem length_restrict_singleton (k : K) (x : Σ k, A k) : · simp [hk] /-- A history has as many inputs as its components together. -/ -theorem length_eq_sum_restrict [Fintype K] (h : List (Σ k, A k)) : +lemma length_eq_sum_restrict [Fintype K] (h : List (Σ k, A k)) : h.length = ∑ k, (restrict k h).length := by classical induction h with @@ -858,17 +858,17 @@ noncomputable def parAll (s : ∀ k, System (A k) (B k)) : System (Σ k, A k) ( variable (s : ∀ k, System (A k) (B k)) -@[simp] theorem parAll_nil : parAll s [] = Part.none := rfl +@[simp] lemma parAll_nil : parAll s [] = Part.none := rfl -theorem parAll_snoc (h : List (Σ k, A k)) (k : K) (a : A k) : +lemma parAll_snoc (h : List (Σ k, A k)) (k : K) (a : A k) : parAll s (h ++ [⟨k, a⟩]) = (s k (restrict k h ++ [a])).map (Sigma.mk k) := by simp [parAll] -theorem parAll_silentAtEmpty : SilentAtEmpty (parAll s) := by +lemma parAll_silentAtEmpty : SilentAtEmpty (parAll s) := by simp [SilentAtEmpty] /-- Reverse induction on histories, split by the component of the last input. -/ -theorem parAll_ext {S : System (Σ k, A k) (Σ k, B k)} {T : System (Σ k, A k) (Σ k, B k)} +lemma parAll_ext {S : System (Σ k, A k) (Σ k, B k)} {T : System (Σ k, A k) (Σ k, B k)} (h0 : S [] = T []) (h1 : ∀ h k a, S (h ++ [⟨k, a⟩]) = T (h ++ [⟨k, a⟩])) : S = T := by funext h induction h using List.reverseRecOn with @@ -876,7 +876,7 @@ theorem parAll_ext {S : System (Σ k, A k) (Σ k, B k)} {T : System (Σ k, A k) | append_singleton h x _ => exact h1 h x.1 x.2 /-- P3: relabeling distributes over parallel composition. -/ -theorem parAll_relabel {A' B' : K → Type} (f : ∀ k, A' k → A k) (g : ∀ k, B k → B' k) : +lemma parAll_relabel {A' B' : K → Type} (f : ∀ k, A' k → A k) (g : ∀ k, B k → B' k) : parAll (fun k => relabel (s k) (f k) (g k)) = relabel (parAll s) (Sigma.map id f) (Sigma.map id g) := by have hr : ∀ (k : K) (h : List (Σ k, A' k)), @@ -903,7 +903,7 @@ def nestMsg {L : K → Type} {A : ∀ k, L k → Type} (y : Σ p : Σ k, L k, A Σ k, Σ l, A k l := ⟨y.1.1, ⟨y.1.2, y.2⟩⟩ /-- P2: flattening a parallel composition of parallel compositions. -/ -theorem parAll_flatten {L : K → Type} {A B : ∀ k, L k → Type} +lemma parAll_flatten {L : K → Type} {A B : ∀ k, L k → Type} (s : ∀ k l, System (A k l) (B k l)) : parAll (fun k => parAll (s k)) = relabel (parAll fun p : Σ k, L k => s p.1 p.2) flatMsg nestMsg := by @@ -933,7 +933,7 @@ theorem parAll_flatten {L : K → Type} {A B : ∀ k, L k → Type} rfl /-- P1: reindexing a parallel composition along a bijection of indices. -/ -theorem parAll_reindex {K' : Type} (τ : K' ≃ K) : +lemma parAll_reindex {K' : Type} (τ : K' ≃ K) : parAll (fun k' => s (τ k')) = relabel (parAll s) (Equiv.sigmaCongrLeft τ (β := A)) (Equiv.sigmaCongrLeft τ (β := B)).symm := by @@ -978,23 +978,23 @@ def optS {Z W : Type} (s₀ : System Z W) (t : ∀ k, System (A k) (B k)) : | none => s₀ | some k => t k -@[simp] theorem restrict_none_cons_none {Z : Type} (z : Z) (h : List (Σ o, optF Z A o)) : +@[simp] lemma restrict_none_cons_none {Z : Type} (z : Z) (h : List (Σ o, optF Z A o)) : restrict (A := optF Z A) none (⟨none, z⟩ :: h) = z :: restrict none h := restrict_cons_self (A := optF Z A) none z h -@[simp] theorem restrict_some_cons_none {Z : Type} (k : K) (z : Z) (h : List (Σ o, optF Z A o)) : +@[simp] lemma restrict_some_cons_none {Z : Type} (k : K) (z : Z) (h : List (Σ o, optF Z A o)) : restrict (A := optF Z A) (some k) (⟨none, z⟩ :: h) = restrict (some k) h := restrict_cons_ne (A := optF Z A) (k := some k) (k' := none) (by simp) z h -@[simp] theorem restrict_none_cons_some {Z : Type} (k : K) (a : A k) (h : List (Σ o, optF Z A o)) : +@[simp] lemma restrict_none_cons_some {Z : Type} (k : K) (a : A k) (h : List (Σ o, optF Z A o)) : restrict (A := optF Z A) none (⟨some k, a⟩ :: h) = restrict none h := restrict_cons_ne (A := optF Z A) (k := none) (k' := some k) (by simp) a h -@[simp] theorem restrict_some_cons_some {Z : Type} (k : K) (a : A k) (h : List (Σ o, optF Z A o)) : +@[simp] lemma restrict_some_cons_some {Z : Type} (k : K) (a : A k) (h : List (Σ o, optF Z A o)) : restrict (A := optF Z A) (some k) (⟨some k, a⟩ :: h) = a :: restrict (some k) h := restrict_cons_self (A := optF Z A) (some k) a h -@[simp] theorem restrict_some_cons_some_ne {Z : Type} {k k' : K} (hk : k' ≠ k) (a : A k') +@[simp] lemma restrict_some_cons_some_ne {Z : Type} {k k' : K} (hk : k' ≠ k) (a : A k') (h : List (Σ o, optF Z A o)) : restrict (A := optF Z A) (some k) (⟨some k', a⟩ :: h) = restrict (some k) h := restrict_cons_ne (A := optF Z A) (k := some k) (k' := some k') (by simpa using hk) a h @@ -1013,7 +1013,7 @@ def injOpt : (Σ o, optF A₀ A o) → Σ o, optF X A o variable {route inj} {s₀ : System X Y} {t : ∀ k, System (A k) (B k)} -theorem parAll_opt_none (H₁ : List (Σ o, optF X A o)) (x : X) : +lemma parAll_opt_none (H₁ : List (Σ o, optF X A o)) (x : X) : parAll (optS s₀ t) (H₁ ++ [⟨none, x⟩]) = (s₀ (restrict none (H₁ ++ [⟨none, x⟩]))).map (Sigma.mk none) := by have e := parAll_snoc (optS s₀ t) H₁ none x @@ -1021,7 +1021,7 @@ theorem parAll_opt_none (H₁ : List (Σ o, optF X A o)) (x : X) : simp only [restrict_append, restrict_none_cons_none, restrict_nil] rfl -theorem exchange_none {T₀ o T'} (l : Exchange s₀ route T₀ o T') : +lemma exchange_none {T₀ o T'} (l : Exchange s₀ route T₀ o T') : ∀ (H₁ : List (Σ o, optF X A o)) (x : X), restrict none (H₁ ++ [⟨none, x⟩]) = T₀ → ∃ H', Exchange (parAll (optS s₀ t)) (routeOpt route) (H₁ ++ [⟨none, x⟩]) (o.map (Sigma.mk none)) H' ∧ @@ -1042,7 +1042,7 @@ theorem exchange_none {T₀ o T'} (l : Exchange s₀ route T₀ o T') : fun k => by rw [h2]; simp⟩ rw [parAll_opt_none]; exact Part.mem_map _ hy -theorem exchange_some (H : List (Σ o, optF X A o)) (k : K) (a : A k) : +lemma exchange_some (H : List (Σ o, optF X A o)) (k : K) (a : A k) : ∃ o, Exchange (parAll (optS s₀ t)) (routeOpt route) (H ++ [⟨some k, a⟩]) o (H ++ [⟨some k, a⟩]) ∧ ∀ c, c ∈ (t k (restrict (some k) H ++ [a])).map (Sigma.mk (some k)) ↔ o = some c := by @@ -1121,7 +1121,7 @@ end Locality section TermClosure /-- T1: a finite parallel composition of terminating systems terminates. -/ -theorem Terminating.parAll {K : Type} [Fintype K] {A B : K → Type} +lemma Terminating.parAll {K : Type} [Fintype K] {A B : K → Type} {s : ∀ k, System (A k) (B k)} (hs : ∀ k, Terminating (s k)) : Terminating (SystemAlgebra.parAll s) := by choose μ hμ using hs @@ -1136,7 +1136,7 @@ theorem Terminating.parAll {K : Type} [Fintype K] {A B : K → Type} · simp [restrict_append, restrict_cons_ne e] · exact ⟨k, Finset.mem_univ _, by simpa using hμ k (restrict k h) a hd⟩ -theorem exchange_some_measure {s : System X Y} {route : Y → B ⊕ X} (μ : List X → ℕ) +lemma exchange_some_measure {s : System X Y} {route : Y → B ⊕ X} (μ : List X → ℕ) (hμ : ∀ h x, (s (h ++ [x])).Dom → μ (h ++ [x]) < μ h) {h o h'} (l : Exchange s route h o h') : ∀ b, o = some b → (s h).Dom ∧ μ h' ≤ μ h := by induction l with @@ -1148,7 +1148,7 @@ theorem exchange_some_measure {s : System X Y} {route : Y → B ⊕ X} (μ : Lis exact ⟨Part.dom_iff_mem.mpr ⟨y, hy⟩, le_trans hle (le_of_lt (hμ h x hd))⟩ /-- T2: wiring a terminating system gives a terminating system. -/ -theorem Terminating.interconnect {s : System X Y} (hs : Terminating s) (route : Y → B ⊕ X) +lemma Terminating.interconnect {s : System X Y} (hs : Terminating s) (route : Y → B ⊕ X) (inj : A → X) : Terminating (SystemAlgebra.interconnect s route inj) := by have hconv := hs.converges route inj obtain ⟨μ, hμ⟩ := hs @@ -1176,11 +1176,11 @@ abbrev Two (Z W : Type) : Type := Σ o, optF Z (fun _ : Unit => W) o noncomputable def pair (a : System A₁ B₁) (b : System A₂ B₂) : System (Two A₁ A₂) (Two B₁ B₂) := parAll (optS a (fun _ : Unit => b)) -@[simp] theorem restrict_two_none_cons_none (z : A₁) (h : List (Two A₁ A₂)) : +@[simp] lemma restrict_two_none_cons_none (z : A₁) (h : List (Two A₁ A₂)) : restrict none (⟨none, z⟩ :: h) = z :: restrict none h := restrict_none_cons_none z h -theorem length_restrict_two (G : List (Two A₁ A₂)) : +lemma length_restrict_two (G : List (Two A₁ A₂)) : (restrict none G).length + (restrict (some ()) G).length = G.length := by induction G with | nil => rfl @@ -1193,11 +1193,11 @@ theorem length_restrict_two (G : List (Two A₁ A₂)) : List.length_cons] omega -theorem pair_left (a : System A₁ B₁) (b : System A₂ B₂) (h : List (Two A₁ A₂)) (x : A₁) : +lemma pair_left (a : System A₁ B₁) (b : System A₂ B₂) (h : List (Two A₁ A₂)) (x : A₁) : pair a b (h ++ [⟨none, x⟩]) = (a (restrict none h ++ [x])).map (Sigma.mk none) := parAll_snoc _ h none x -theorem pair_right (a : System A₁ B₁) (b : System A₂ B₂) (h : List (Two A₁ A₂)) (x : A₂) : +lemma pair_right (a : System A₁ B₁) (b : System A₂ B₂) (h : List (Two A₁ A₂)) (x : A₂) : pair a b (h ++ [⟨some (), x⟩]) = (b (restrict (some ()) h ++ [x])).map (Sigma.mk (some ())) := parAll_snoc _ h (some ()) x @@ -1223,20 +1223,20 @@ def twoAssoc' {Z W V : Type} : Two Z (Two W V) → Two (Two Z W) V | ⟨some (), ⟨none, w⟩⟩ => ⟨none, ⟨some (), w⟩⟩ | ⟨some (), ⟨some (), v⟩⟩ => ⟨some (), v⟩ -theorem restrict_twoMap_none {Z Z' W W' : Type} (f : Z → Z') (g : W → W') (h : List (Two Z W)) : +lemma restrict_twoMap_none {Z Z' W W' : Type} (f : Z → Z') (g : W → W') (h : List (Two Z W)) : restrict none (h.map (twoMap f g)) = (restrict none h).map f := by induction h with | nil => rfl | cons x h ih => rcases x with ⟨_ | ⟨⟩, x⟩ <;> simp [twoMap, ih] -theorem restrict_twoMap_some {Z Z' W W' : Type} (f : Z → Z') (g : W → W') (h : List (Two Z W)) : +lemma restrict_twoMap_some {Z Z' W W' : Type} (f : Z → Z') (g : W → W') (h : List (Two Z W)) : restrict (some ()) (h.map (twoMap f g)) = (restrict (some ()) h).map g := by induction h with | nil => rfl | cons x h ih => rcases x with ⟨_ | ⟨⟩, x⟩ <;> simp [twoMap, ih] /-- Relabeling each component of a pair. -/ -theorem pair_relabel {A₁' B₁' A₂' B₂' : Type} (a : System A₁ B₁) (b : System A₂ B₂) +lemma pair_relabel {A₁' B₁' A₂' B₂' : Type} (a : System A₁ B₁) (b : System A₂ B₂) (f : A₁' → A₁) (g : B₁ → B₁') (f' : A₂' → A₂) (g' : B₂ → B₂') : pair (relabel a f g) (relabel b f' g') = relabel (pair a b) (twoMap f f') (twoMap g g') := by apply parAll_ext @@ -1254,20 +1254,20 @@ theorem pair_relabel {A₁' B₁' A₂' B₂' : Type} (a : System A₁ B₁) (b rw [parAll_snoc, parAll_snoc] simp [optS, relabel, restrict_twoMap_some, Part.map_map, twoMap, Function.comp_def] -theorem restrict_twoSwap_none {Z W : Type} (h : List (Two Z W)) : +lemma restrict_twoSwap_none {Z W : Type} (h : List (Two Z W)) : restrict none (h.map twoSwap) = restrict (some ()) h := by induction h with | nil => rfl | cons x h ih => rcases x with ⟨_ | ⟨⟩, x⟩ <;> simp [twoSwap, ih] -theorem restrict_twoSwap_some {Z W : Type} (h : List (Two Z W)) : +lemma restrict_twoSwap_some {Z W : Type} (h : List (Two Z W)) : restrict (some ()) (h.map twoSwap) = restrict none h := by induction h with | nil => rfl | cons x h ih => rcases x with ⟨_ | ⟨⟩, x⟩ <;> simp [twoSwap, ih] /-- Swapping the two components of a pair. -/ -theorem pair_swap (a : System A₁ B₁) (b : System A₂ B₂) : +lemma pair_swap (a : System A₁ B₁) (b : System A₂ B₂) : pair b a = relabel (pair a b) twoSwap twoSwap := by apply parAll_ext · simp [relabel, pair] @@ -1284,26 +1284,26 @@ theorem pair_swap (a : System A₁ B₁) (b : System A₂ B₂) : rw [parAll_snoc, parAll_snoc] simp [optS, restrict_twoSwap_none, Part.map_map, twoSwap, Function.comp_def] -theorem restrict_twoAssoc_a {Z W V : Type} (h : List (Two (Two Z W) V)) : +lemma restrict_twoAssoc_a {Z W V : Type} (h : List (Two (Two Z W) V)) : restrict none (h.map twoAssoc) = restrict none (restrict none h) := by induction h with | nil => rfl | cons x h ih => rcases x with ⟨_ | ⟨⟩, x⟩ <;> [rcases x with ⟨_ | ⟨⟩, x⟩; skip] <;> simp [twoAssoc, ih] -theorem restrict_twoAssoc_b {Z W V : Type} (h : List (Two (Two Z W) V)) : +lemma restrict_twoAssoc_b {Z W V : Type} (h : List (Two (Two Z W) V)) : restrict none (restrict (some ()) (h.map twoAssoc)) = restrict (some ()) (restrict none h) := by induction h with | nil => rfl | cons x h ih => rcases x with ⟨_ | ⟨⟩, x⟩ <;> [rcases x with ⟨_ | ⟨⟩, x⟩; skip] <;> simp [twoAssoc, ih] -theorem restrict_twoAssoc_c {Z W V : Type} (h : List (Two (Two Z W) V)) : +lemma restrict_twoAssoc_c {Z W V : Type} (h : List (Two (Two Z W) V)) : restrict (some ()) (restrict (some ()) (h.map twoAssoc)) = restrict (some ()) h := by induction h with | nil => rfl | cons x h ih => rcases x with ⟨_ | ⟨⟩, x⟩ <;> [rcases x with ⟨_ | ⟨⟩, x⟩; skip] <;> simp [twoAssoc, ih] /-- Associativity of pairs. -/ -theorem pair_assoc (a : System A₁ B₁) (b : System A₂ B₂) (c : System A₃ B₃) : +lemma pair_assoc (a : System A₁ B₁) (b : System A₂ B₂) (c : System A₃ B₃) : pair (pair a b) c = relabel (pair a (pair b c)) twoAssoc twoAssoc' := by apply parAll_ext · simp [relabel, pair] @@ -1324,24 +1324,24 @@ theorem pair_assoc (a : System A₁ B₁) (b : System A₂ B₂) (c : System A parAll_snoc] simp [optS, parAll_snoc, restrict_twoAssoc_c, Part.map_map, twoAssoc', Function.comp_def] -theorem Terminating.pair {a : System A₁ B₁} {b : System A₂ B₂} (ha : Terminating a) +lemma Terminating.pair {a : System A₁ B₁} {b : System A₂ B₂} (ha : Terminating a) (hb : Terminating b) : Terminating (SystemAlgebra.pair a b) := Terminating.parAll (fun o => by cases o <;> assumption) -theorem pair_relabel_left {A₁' B₁' : Type} (a : System A₁ B₁) (b : System A₂ B₂) +lemma pair_relabel_left {A₁' B₁' : Type} (a : System A₁ B₁) (b : System A₂ B₂) (f : A₁' → A₁) (g : B₁ → B₁') : pair (relabel a f g) b = relabel (pair a b) (twoMap f id) (twoMap g id) := by have := pair_relabel a b f g id id rwa [relabel_id] at this -theorem pair_relabel_right {A₂' B₂' : Type} (a : System A₁ B₁) (b : System A₂ B₂) +lemma pair_relabel_right {A₂' B₂' : Type} (a : System A₁ B₁) (b : System A₂ B₂) (f : A₂' → A₂) (g : B₂ → B₂') : pair a (relabel b f g) = relabel (pair a b) (twoMap id f) (twoMap id g) := by have := pair_relabel a b id id f g rwa [relabel_id] at this /-- Associativity of pairs, read from right to left. -/ -theorem pair_assoc' (a : System A₁ B₁) (b : System A₂ B₂) (c : System A₃ B₃) : +lemma pair_assoc' (a : System A₁ B₁) (b : System A₂ B₂) (c : System A₃ B₃) : pair a (pair b c) = relabel (pair (pair a b) c) twoAssoc' twoAssoc := by rw [pair_assoc, relabel_relabel] have e1 : (twoAssoc ∘ twoAssoc' : Two A₁ (Two A₂ A₃) → _) = id := by @@ -1356,26 +1356,26 @@ def twoLComm {Z W V : Type} : Two Z (Two W V) → Two W (Two Z V) | ⟨some (), ⟨none, w⟩⟩ => ⟨none, w⟩ | ⟨some (), ⟨some (), v⟩⟩ => ⟨some (), ⟨some (), v⟩⟩ -theorem restrict_twoLComm_a {Z W V : Type} (h : List (Two Z (Two W V))) : +lemma restrict_twoLComm_a {Z W V : Type} (h : List (Two Z (Two W V))) : restrict none (restrict (some ()) (h.map twoLComm)) = restrict none h := by induction h with | nil => rfl | cons x h ih => rcases x with ⟨_ | ⟨⟩, x⟩ <;> [skip; rcases x with ⟨_ | ⟨⟩, x⟩] <;> simp [twoLComm, ih] -theorem restrict_twoLComm_b {Z W V : Type} (h : List (Two Z (Two W V))) : +lemma restrict_twoLComm_b {Z W V : Type} (h : List (Two Z (Two W V))) : restrict none (h.map twoLComm) = restrict none (restrict (some ()) h) := by induction h with | nil => rfl | cons x h ih => rcases x with ⟨_ | ⟨⟩, x⟩ <;> [skip; rcases x with ⟨_ | ⟨⟩, x⟩] <;> simp [twoLComm, ih] -theorem restrict_twoLComm_c {Z W V : Type} (h : List (Two Z (Two W V))) : +lemma restrict_twoLComm_c {Z W V : Type} (h : List (Two Z (Two W V))) : restrict (some ()) (restrict (some ()) (h.map twoLComm)) = restrict (some ()) (restrict (some ()) h) := by induction h with | nil => rfl | cons x h ih => rcases x with ⟨_ | ⟨⟩, x⟩ <;> [skip; rcases x with ⟨_ | ⟨⟩, x⟩] <;> simp [twoLComm, ih] /-- Exchanging the first two of three components. -/ -theorem pair_left_comm (a : System A₁ B₁) (b : System A₂ B₂) (c : System A₃ B₃) : +lemma pair_left_comm (a : System A₁ B₁) (b : System A₂ B₂) (c : System A₃ B₃) : pair b (pair a c) = relabel (pair a (pair b c)) twoLComm twoLComm := by apply parAll_ext · simp [relabel, pair] @@ -1397,7 +1397,7 @@ theorem pair_left_comm (a : System A₁ B₁) (b : System A₂ B₂) (c : System simp [optS, parAll_snoc, restrict_twoLComm_c, Part.map_map, twoLComm, Function.comp_def] /-- Locality on the left component of a pair. -/ -theorem pair_interconnect_left {X Y B₀ A₀ : Type} {a : System X Y} +lemma pair_interconnect_left {X Y B₀ A₀ : Type} {a : System X Y} {route : Y → B₀ ⊕ X} {inj : A₀ → X} (ha : Converges a route inj) (b : System A₂ B₂) : pair (interconnect a route inj) b = interconnect (pair a b) (routeOpt (B := fun _ : Unit => B₂) route) (injOpt (A := fun _ : Unit => A₂) inj) := @@ -1409,7 +1409,7 @@ def routeRight {Y X B₀ : Type} (route : Y → B₀ ⊕ X) : Two B₁ Y → Two | ⟨some (), y⟩ => (route y).elim (fun b => .inl ⟨some (), b⟩) (fun x => .inr ⟨some (), x⟩) /-- Locality on the right component of a pair. -/ -theorem pair_interconnect_right {X Y B₀ A₀ : Type} (a : System A₁ B₁) {b : System X Y} +lemma pair_interconnect_right {X Y B₀ A₀ : Type} (a : System A₁ B₁) {b : System X Y} {route : Y → B₀ ⊕ X} {inj : A₀ → X} (hb : Converges b route inj) : pair a (interconnect b route inj) = interconnect (pair a b) (routeRight route) (twoMap id inj) := by rw [pair_swap, pair_interconnect_left hb, relabel_interconnect, pair_swap, interconnect_relabel] @@ -1429,7 +1429,7 @@ def twoMiddle {A B C D : Type} : Two (Two A B) (Two C D) → Two (Two A C) (Two | ⟨some (), ⟨none, c⟩⟩ => ⟨none, ⟨some (), c⟩⟩ | ⟨some (), ⟨some (), d⟩⟩ => ⟨some (), ⟨some (), d⟩⟩ -theorem pair_middle {A B C D W X Y Z : Type} +lemma pair_middle {A B C D W X Y Z : Type} (a : System A W) (b : System B X) (c : System C Y) (d : System D Z) : pair (pair a b) (pair c d) = relabel (pair (pair a c) (pair b d)) twoMiddle twoMiddle := by @@ -1466,7 +1466,7 @@ def Transparent (R : Two Y D' → B ⊕ Two X C) (inj : A → Two X C) (φ : C (∀ y, R ⟨none, y⟩ = .inl (g y) ∨ ∃ x, R ⟨none, y⟩ = .inr ⟨some (), x⟩ ∧ R ⟨some (), φ x⟩ = .inl (g y)) -theorem exchange_forward (hc : Forwarder c φ) (hT : Transparent R inj φ f g) +lemma exchange_forward (hc : Forwarder c φ) (hT : Transparent R inj φ f g) (H₁ : List (Two X C)) (x : X) : ∃ o H', Exchange (pair s c) R (H₁ ++ [⟨none, x⟩]) o H' ∧ restrict none H' = restrict none (H₁ ++ [⟨none, x⟩]) ∧ @@ -1493,7 +1493,7 @@ theorem exchange_forward (hc : Forwarder c φ) (hT : Transparent R inj φ f g) simp only [reduceCtorEq, iff_false, Part.mem_map_iff, not_exists, not_and] exact fun y hy _ => hd (Part.dom_iff_mem.mpr ⟨y, hy⟩) -theorem exchange_input (hc : Forwarder c φ) (hT : Transparent R inj φ f g) +lemma exchange_input (hc : Forwarder c φ) (hT : Transparent R inj φ f g) (H : List (Two X C)) (a : A) : ∃ o H', Exchange (pair s c) R (H ++ [inj a]) o H' ∧ restrict none H' = restrict none H ++ [f a] ∧ @@ -1510,7 +1510,7 @@ theorem exchange_input (hc : Forwarder c φ) (hT : Transparent R inj φ f g) exact Part.mem_map _ (Part.mem_some _) /-- A forwarder wired to a reactive `s` is transparent. -/ -theorem interconnect_forwarder (hs : SilentAtEmpty s) (hc : Forwarder c φ) (hT : Transparent R inj φ f g) : +lemma interconnect_forwarder (hs : SilentAtEmpty s) (hc : Forwarder c φ) (hT : Transparent R inj φ f g) : interconnect (pair s c) R inj = relabel s f g := by have key : ∀ u, ∃ o H, Induces (pair s c) R inj u o H ∧ restrict none H = u.map f ∧ ∀ b, b ∈ relabel s f g u ↔ o = some b := by @@ -1543,11 +1543,11 @@ section Behaviour variable {s t : System X Y} -@[simp] theorem reach_nil (s : System X Y) : Reach s [] := by +@[simp] lemma reach_nil (s : System X Y) : Reach s [] := by intro h' e he hne exact (hne (List.append_eq_nil_iff.mp he.symm).1).elim -theorem reach_snoc_iff {h : List X} {x : X} : +lemma reach_snoc_iff {h : List X} {x : X} : Reach s (h ++ [x]) ↔ Reach s h ∧ (s (h ++ [x])).Dom := by constructor · intro hr @@ -1563,14 +1563,14 @@ theorem reach_snoc_iff {h : List X} {x : X} : /-- For a DDS, a nonempty history is reachable exactly when it is in the domain. Prefix closure, rather than total responsiveness, supplies all earlier replies. -/ -theorem IsDDS.reach_iff (hs : IsDDS s) {h : List X} (hne : h ≠ []) : +lemma IsDDS.reach_iff (hs : IsDDS s) {h : List X} (hne : h ≠ []) : Reach s h ↔ (s h).Dom := ⟨fun hr => hr h [] (by simp) hne, fun hd p e he hp => hs.2 ⟨e, he.symm⟩ hp hd⟩ /-- On DDSs, behavioral equality is equality of the partial history functions. This includes both the domain and every defined reply. -/ -theorem EqOnReachable.eq_of_isDDS (hst : s ≈ₛ t) (hs : IsDDS s) (ht : IsDDS t) : s = t := by +lemma EqOnReachable.eq_of_isDDS (hst : s ≈ₛ t) (hs : IsDDS s) (ht : IsDDS t) : s = t := by apply system_ext intro h y by_cases hn : h = [] @@ -1585,7 +1585,7 @@ theorem EqOnReachable.eq_of_isDDS (hst : s ≈ₛ t) (hs : IsDDS s) (ht : IsDDS exact hy /-- R1: trimming does not change the behaviour. -/ -theorem trim_behEq (s : System X Y) : trim s ≈ₛ s := by +lemma trim_behEq (s : System X Y) : trim s ≈ₛ s := by have hreach : ∀ h, Reach (trim s) h ↔ Reach s h := by intro h induction h using List.reverseRecOn with @@ -1607,14 +1607,14 @@ theorem trim_behEq (s : System X Y) : trim s ≈ₛ s := by /-- After a reachable history, trimming preserves the next partial reply, including undefinedness. -/ -theorem trim_snoc_of_reach {h : List X} (hr : Reach s h) (x : X) : +lemma trim_snoc_of_reach {h : List X} (hr : Reach s h) (x : X) : trim s (h ++ [x]) = s (h ++ [x]) := by by_cases hd : (s (h ++ [x])).Dom · exact if_pos (reach_snoc_iff.mpr ⟨hr, hd⟩) · rw [trim, if_neg (fun ht => hd (reach_snoc_iff.mp ht).2), Part.eq_none_iff'.mpr hd] /-- R1: a trimmed system has a prefix-closed domain. -/ -theorem trim_prefix_closed (s : System X Y) {h e : List X} (hd : (trim s (h ++ e)).Dom) +lemma trim_prefix_closed (s : System X Y) {h e : List X} (hd : (trim s (h ++ e)).Dom) (hne : h ≠ []) : (trim s h).Dom := by by_cases hr : Reach s (h ++ e) · have := hr h e rfl hne @@ -1623,17 +1623,17 @@ theorem trim_prefix_closed (s : System X Y) {h e : List X} (hd : (trim s (h ++ e · simp [trim, hr] at hd /-- Restricting to reachable histories preserves a reactive system's silence at `[]`. -/ -theorem SilentAtEmpty.isDDS_trim (hs : SilentAtEmpty s) : IsDDS (trim s) := by +lemma SilentAtEmpty.isDDS_trim (hs : SilentAtEmpty s) : IsDDS (trim s) := by refine ⟨by simpa [SilentAtEmpty, trim] using hs, ?_⟩ rintro h k ⟨e, rfl⟩ hn hd exact trim_prefix_closed s hd hn /-- A DDS already has exactly its reachable nonempty histories. -/ -theorem IsDDS.trim_eq (hs : IsDDS s) : trim s = s := +lemma IsDDS.trim_eq (hs : IsDDS s) : trim s = s := (trim_behEq s).eq_of_isDDS hs.1.isDDS_trim hs /-- B for relabeling. -/ -theorem EqOnReachable.relabel (hst : s ≈ₛ t) (f : A → X) (g : Y → B) : +lemma EqOnReachable.relabel (hst : s ≈ₛ t) (f : A → X) (g : Y → B) : SystemAlgebra.relabel s f g ≈ₛ SystemAlgebra.relabel t f g := by have hr : ∀ (u : System X Y) h, Reach (SystemAlgebra.relabel u f g) h ↔ Reach u (h.map f) := by intro u h @@ -1647,7 +1647,7 @@ theorem EqOnReachable.relabel (hst : s ≈ₛ t) (f : A → X) (g : Y → B) : rw [hst.2 _ ((hr s h).mp hh) (by simpa using hne)] /-- Trimming commutes with a change of the input and output vocabulary. -/ -theorem trim_relabel {A B X Y : Type} (s : System X Y) (f : A → X) (g : Y → B) : +lemma trim_relabel {A B X Y : Type} (s : System X Y) (f : A → X) (g : Y → B) : trim (relabel s f g) = relabel (trim s) f g := by funext h have hr : Reach (relabel s f g) h ↔ Reach s (h.map f) := by @@ -1667,7 +1667,7 @@ section BehaviourPar variable {K : Type} {A B : K → Type} {s t : ∀ k, System (A k) (B k)} -theorem reach_restrict {h : List (Σ k, A k)} (hr : Reach (parAll s) h) (k : K) : +lemma reach_restrict {h : List (Σ k, A k)} (hr : Reach (parAll s) h) (k : K) : Reach (s k) (restrict k h) := by induction h using List.reverseRecOn with | nil => simp @@ -1684,7 +1684,7 @@ theorem reach_restrict {h : List (Σ k, A k)} (hr : Reach (parAll s) h) (k : K) /-- A parallel transcript is reachable exactly when all its component projections are reachable. -/ -theorem reach_parAll_iff (h : List (Σ k, A k)) : +lemma reach_parAll_iff (h : List (Σ k, A k)) : Reach (parAll s) h ↔ ∀ k, Reach (s k) (restrict k h) := by refine ⟨fun hr k => reach_restrict hr k, ?_⟩ intro hr p e he hn @@ -1695,7 +1695,7 @@ theorem reach_parAll_iff (h : List (Σ k, A k)) : /-- The reachable parallel composition of DDSs has exactly the intersection of their projected domains, with the empty input history excluded. -/ -theorem trim_parAll_dom (hs : ∀ k, IsDDS (s k)) (h : List (Σ k, A k)) : +lemma trim_parAll_dom (hs : ∀ k, IsDDS (s k)) (h : List (Σ k, A k)) : (trim (parAll s) h).Dom ↔ h ≠ [] ∧ ∀ k, restrict k h = [] ∨ (s k (restrict k h)).Dom := by have hr : Reach (parAll s) h ↔ ∀ k, restrict k h = [] ∨ (s k (restrict k h)).Dom := by @@ -1720,7 +1720,7 @@ theorem trim_parAll_dom (hs : ∀ k, IsDDS (s k)) (h : List (Σ k, A k)) : exact hreach h [] (by simp) hn /-- B for parallel composition. -/ -theorem EqOnReachable.parAll (hst : ∀ k, s k ≈ₛ t k) : +lemma EqOnReachable.parAll (hst : ∀ k, s k ≈ₛ t k) : SystemAlgebra.parAll s ≈ₛ SystemAlgebra.parAll t := by have hdom : ∀ h k a, Reach (SystemAlgebra.parAll s) h → ((s k (restrict k h ++ [a])).Dom ↔ (t k (restrict k h ++ [a])).Dom) := by @@ -1753,7 +1753,7 @@ theorem EqOnReachable.parAll (hst : ∀ k, s k ≈ₛ t k) : rw [(hst k).2 _ h1 (by simp)] /-- R2: the trimmed parallel composition of finite systems is finite. -/ -theorem finite_trim_parAll [Fintype K] {n : K → ℕ} (hs : ∀ k, Finite (n k) (s k)) : +lemma finite_trim_parAll [Fintype K] {n : K → ℕ} (hs : ∀ k, Finite (n k) (s k)) : Finite (∑ k, n k) (trim (SystemAlgebra.parAll s)) := by intro h hd have hr : Reach (SystemAlgebra.parAll s) h := by @@ -1790,7 +1790,7 @@ section BehaviourWire variable {s t : System X Y} {route : Y → B ⊕ X} {inj : A → X} -theorem exchange_of_behEq (hst : s ≈ₛ t) {h₀ o h'} (l : Exchange s route h₀ o h') : +lemma exchange_of_behEq (hst : s ≈ₛ t) {h₀ o h'} (l : Exchange s route h₀ o h') : ∀ h x, h₀ = h ++ [x] → Reach s h → Exchange t route h₀ o h' := by induction l with | silent g hd => @@ -1808,7 +1808,7 @@ theorem exchange_of_behEq (hst : s ≈ₛ t) {h₀ o h'} (l : Exchange s route h exact Exchange.feed _ y x' _ _ (by rw [← hst.2 _ hrx (by simp)]; exact hy) hb (ih (h ++ [x]) x' rfl hrx) -theorem reach_of_exchange_some {h x b h'} (l : Exchange s route (h ++ [x]) (some b) h') +lemma reach_of_exchange_some {h x b h'} (l : Exchange s route (h ++ [x]) (some b) h') (hr : Reach s h) : Reach s h' := by generalize e : h ++ [x] = g at l generalize eb : some b = ob at l @@ -1820,7 +1820,7 @@ theorem reach_of_exchange_some {h x b h'} (l : Exchange s route (h ++ [x]) (some exact ih (reach_snoc_iff.mpr ⟨hr, Part.dom_iff_mem.mpr ⟨y, hy⟩⟩) rfl eb /-- B for connection: behavioural equality is preserved by wiring, with no hypothesis. -/ -theorem EqOnReachable.interconnect (hst : s ≈ₛ t) (route : Y → B ⊕ X) (inj : A → X) : +lemma EqOnReachable.interconnect (hst : s ≈ₛ t) (route : Y → B ⊕ X) (inj : A → X) : SystemAlgebra.interconnect s route inj ≈ₛ SystemAlgebra.interconnect t route inj := by have hts : t ≈ₛ s := ⟨fun h => (hst.1 h).symm, fun h hr hne => (hst.2 h ((hst.1 h).mpr hr) hne).symm⟩ -- replies after a reachable internal history agree @@ -1882,13 +1882,13 @@ theorem EqOnReachable.interconnect (hst : s ≈ₛ t) (route : Y → B ⊕ X) (i obtain ⟨o, H, rs, rt, hH⟩ := (key u).2 hr0 exact Part.ext fun b => step (Or.inr ⟨o, rs⟩) hH (Or.inr ⟨o, rt⟩) -theorem exchange_some_dom {h o h'} (l : Exchange s route h o h') : ∀ b, o = some b → (s h').Dom := by +lemma exchange_some_dom {h o h'} (l : Exchange s route h o h') : ∀ b, o = some b → (s h').Dom := by induction l with | silent => intro b e; cases e | out h y _ hy _ => intro _ _; exact Part.dom_iff_mem.mpr ⟨y, hy⟩ | feed _ _ _ _ _ _ _ _ ih => exact ih -theorem Induces.length_le {u o H} (r : Induces s route inj u o H) : u.length ≤ H.length := by +lemma Induces.length_le {u o H} (r : Induces s route inj u o H) : u.length ≤ H.length := by induction r with | nil => simp | snoc u a o₀ H o H' _ l ih => @@ -1896,28 +1896,28 @@ theorem Induces.length_le {u o H} (r : Induces s route inj u o H) : u.length ≤ simp omega -theorem exchange_start_dom {h o h'} (l : Exchange s route h o h') : ∀ b, o = some b → (s h).Dom := by +lemma exchange_start_dom {h o h'} (l : Exchange s route h o h') : ∀ b, o = some b → (s h).Dom := by cases l with | silent => intro b e; cases e | out _ y _ hy _ => intro _ _; exact Part.dom_iff_mem.mpr ⟨y, hy⟩ | feed _ y _ _ _ hy _ _ => intro _ _; exact Part.dom_iff_mem.mpr ⟨y, hy⟩ -@[simp] theorem interconnect_nil : SystemAlgebra.interconnect s route inj [] = Part.none := interconnect_eq_none Induces.nil +@[simp] lemma interconnect_nil : SystemAlgebra.interconnect s route inj [] = Part.none := interconnect_eq_none Induces.nil -theorem EqOnReachable.symm {t : System X Y} (hst : s ≈ₛ t) : t ≈ₛ s := +lemma EqOnReachable.symm {t : System X Y} (hst : s ≈ₛ t) : t ≈ₛ s := ⟨fun h => (hst.1 h).symm, fun h hr hne => (hst.2 h ((hst.1 h).mpr hr) hne).symm⟩ -theorem EqOnReachable.trans {t u : System X Y} (hst : s ≈ₛ t) (htu : t ≈ₛ u) : s ≈ₛ u := +lemma EqOnReachable.trans {t u : System X Y} (hst : s ≈ₛ t) (htu : t ≈ₛ u) : s ≈ₛ u := ⟨fun h => (hst.1 h).trans (htu.1 h), fun h hr hn => (hst.2 h hr hn).trans (htu.2 h ((hst.1 h).mp hr) hn)⟩ -theorem EqOnReachable.trim_eq {t : System X Y} (hst : s ≈ₛ t) (hs : SilentAtEmpty s) (ht : SilentAtEmpty t) : +lemma EqOnReachable.trim_eq {t : System X Y} (hst : s ≈ₛ t) (hs : SilentAtEmpty s) (ht : SilentAtEmpty t) : trim s = trim t := ((trim_behEq s).trans (hst.trans (trim_behEq t).symm)).eq_of_isDDS hs.isDDS_trim ht.isDDS_trim /-- R3: connecting a finite system gives a finite system. -/ -theorem Finite.interconnect {n : ℕ} (hs : Finite n s) : Finite n (SystemAlgebra.interconnect s route inj) := by +lemma Finite.interconnect {n : ℕ} (hs : Finite n s) : Finite n (SystemAlgebra.interconnect s route inj) := by intro u hd obtain ⟨H, r⟩ := mem_interconnect.mp (Part.get_mem hd) refine le_trans r.length_le (hs H ?_) @@ -1942,17 +1942,17 @@ inductive Transcript (s : System A B) (e : List B →. A) : List A → List B variable {s t : System A B} -theorem Transcript.length_eq {e xs ys} (tr : Transcript s e xs ys) : xs.length = ys.length := by +lemma Transcript.length_eq {e xs ys} (tr : Transcript s e xs ys) : xs.length = ys.length := by induction tr with | nil => rfl | snoc _ _ _ ih => simp [ih] -theorem Transcript.reach {e xs ys} (tr : Transcript s e xs ys) : Reach s xs := by +lemma Transcript.reach {e xs ys} (tr : Transcript s e xs ys) : Reach s xs := by induction tr with | nil => exact reach_nil s | snoc _ _ hy ih => exact reach_snoc_iff.mpr ⟨ih, Part.dom_iff_mem.mpr ⟨_, hy⟩⟩ -theorem Transcript.snoc_inv {e xs ys' x} (tr : Transcript s e (xs ++ [x]) ys') : +lemma Transcript.snoc_inv {e xs ys' x} (tr : Transcript s e (xs ++ [x]) ys') : ∃ ys y, ys' = ys ++ [y] ∧ Transcript s e xs ys ∧ x ∈ e ys ∧ y ∈ s (xs ++ [x]) := by generalize hx : xs ++ [x] = xs' at tr cases tr with @@ -1961,7 +1961,7 @@ theorem Transcript.snoc_inv {e xs ys' x} (tr : Transcript s e (xs ++ [x]) ys') : obtain ⟨rfl, rfl⟩ := List.append_inj' hx rfl |>.imp id (fun h => by simpa using h.symm) exact ⟨_, _, rfl, tr, hx', hy⟩ -theorem Transcript.take {e xs ys} (tr : Transcript s e xs ys) (n : ℕ) : +lemma Transcript.take {e xs ys} (tr : Transcript s e xs ys) (n : ℕ) : Transcript s e (xs.take n) (ys.take n) := by induction tr with | nil => simp only [List.take_nil]; exact Transcript.nil @@ -1976,7 +1976,7 @@ theorem Transcript.take {e xs ys} (tr : Transcript s e xs ys) (n : ℕ) : /-- At each length, two deterministic systems have only one interaction transcript. -/ -theorem Transcript.eq_of_length_eq {e xs ys xs' ys'} (tr : Transcript s e xs ys) +lemma Transcript.eq_of_length_eq {e xs ys xs' ys'} (tr : Transcript s e xs ys) (tr' : Transcript s e xs' ys') (hl : xs.length = xs'.length) : xs = xs' ∧ ys = ys' := by induction tr generalizing xs' ys' with | nil => @@ -1992,7 +1992,7 @@ theorem Transcript.eq_of_length_eq {e xs ys xs' ys'} (tr : Transcript s e xs ys) obtain rfl := Part.mem_unique hy hy' exact ⟨rfl, rfl⟩ -theorem Transcript.length_le_of_stopped {e xs ys xs' ys'} (tr : Transcript s e xs ys) +lemma Transcript.length_le_of_stopped {e xs ys xs' ys'} (tr : Transcript s e xs ys) (hd : ¬ (e ys).Dom) (tr' : Transcript s e xs' ys') : xs'.length ≤ xs.length := by by_contra hn have hl : xs.length < xs'.length := Nat.lt_of_not_ge hn @@ -2003,7 +2003,7 @@ theorem Transcript.length_le_of_stopped {e xs ys xs' ys'} (tr : Transcript s e x exact hd (he ▸ Part.dom_iff_mem.mpr ⟨_, hx⟩) /-- Completed transcripts are unique, including for partial systems. -/ -theorem Transcript.eq_of_stopped {e xs ys xs' ys'} (tr : Transcript s e xs ys) +lemma Transcript.eq_of_stopped {e xs ys xs' ys'} (tr : Transcript s e xs ys) (tr' : Transcript s e xs' ys') (hd : ¬ (e ys).Dom) (hd' : ¬ (e ys').Dom) : xs = xs' ∧ ys = ys' := tr.eq_of_length_eq tr' (le_antisymm (tr'.length_le_of_stopped hd' tr) @@ -2012,7 +2012,7 @@ theorem Transcript.eq_of_stopped {e xs ys xs' ys'} (tr : Transcript s e xs ys) /-- The environment that issues the queries `H` in order, ignoring the replies. -/ def fixedQueries (H : List A) : List B →. A := fun ys => (H[ys.length]? : Part A) -theorem transcript_fixedQueries {H : List A} : +lemma transcript_fixedQueries {H : List A} : ∀ h e', H = h ++ e' → (Reach s h ↔ ∃ ys, Transcript s (fixedQueries H) h ys) := by intro h induction h using List.reverseRecOn with @@ -2030,7 +2030,7 @@ theorem transcript_fixedQueries {H : List A} : exact tr.reach /-- Behavioural equality is equality of the transcripts with every environment. -/ -theorem behEq_iff_transcript : +lemma behEq_iff_transcript : s ≈ₛ t ↔ ∀ e xs ys, Transcript s e xs ys ↔ Transcript t e xs ys := by constructor · intro hst @@ -2090,9 +2090,9 @@ noncomputable def runRev (P : Y → Prop) (s : System X Y) : List X → ℕ noncomputable def run (P : Y → Prop) (s : System X Y) (h : List X) : ℕ := runRev P s h.reverse -@[simp] theorem run_nil (P : Y → Prop) (s : System X Y) : run P s [] = 0 := rfl +@[simp] lemma run_nil (P : Y → Prop) (s : System X Y) : run P s [] = 0 := rfl -theorem run_snoc (P : Y → Prop) (s : System X Y) (h : List X) (x : X) : +lemma run_snoc (P : Y → Prop) (s : System X Y) (h : List X) (x : X) : run P s (h ++ [x]) = if ∃ y ∈ s (h ++ [x]), P y then run P s h + 1 else 0 := by simp [run, runRev] @@ -2111,18 +2111,18 @@ structure CyclesThrough (P : Ya → Prop) (route : Two Ya Yb → B ⊕ Two Xa Xb left_in : ∀ y, P y → (∃ c, route ⟨none, y⟩ = .inl c) ∨ ∃ x, route ⟨none, y⟩ = .inr ⟨some (), x⟩ right : ∀ y, (∃ c, route ⟨some (), y⟩ = .inl c) ∨ ∃ x, route ⟨some (), y⟩ = .inr ⟨none, x⟩ -theorem restrict_none_snoc_left (G : List (Two Xa Xb)) (z : Xa) : +lemma restrict_none_snoc_left (G : List (Two Xa Xb)) (z : Xa) : restrict none (G ++ [⟨none, z⟩]) = restrict none G ++ [z] := by simp -theorem restrict_some_snoc_left (G : List (Two Xa Xb)) (z : Xa) : +lemma restrict_some_snoc_left (G : List (Two Xa Xb)) (z : Xa) : restrict (some ()) (G ++ [⟨none, z⟩]) = restrict (some ()) G := by rw [restrict_append, restrict_cons_ne (by simp)]; simp -theorem restrict_none_snoc_right (G : List (Two Xa Xb)) (x : Xb) : +lemma restrict_none_snoc_right (G : List (Two Xa Xb)) (x : Xb) : restrict none (G ++ [⟨some (), x⟩]) = restrict none G := by rw [restrict_append, restrict_cons_ne (by simp)]; simp -theorem restrict_some_snoc_right (G : List (Two Xa Xb)) (x : Xb) : +lemma restrict_some_snoc_right (G : List (Two Xa Xb)) (x : Xb) : restrict (some ()) (G ++ [⟨some (), x⟩]) = restrict (some ()) G ++ [x] := by simp section Measure @@ -2132,7 +2132,7 @@ variable (hc : CyclesThrough P route) (ν : List Xa → ℕ) include hc hν /-- From a turn of `a`, the exchange stops. -/ -theorem exchange_left_turn : +lemma exchange_left_turn : ∀ m (G : List (Two Xa Xb)) (z : Xa), ν (restrict none G ++ [z]) = m → ∃ o G', Exchange (pair a b) route (G ++ [⟨none, z⟩]) o G' := by intro m @@ -2191,7 +2191,7 @@ theorem exchange_left_turn : · exact ⟨none, _, Exchange.silent _ (by rw [hpl']; exact hd')⟩ /-- Every exchange of `[a, b]` stops. -/ -theorem exchange_pair (G : List (Two Xa Xb)) : ∃ o G', Exchange (pair a b) route G o G' := by +lemma exchange_pair (G : List (Two Xa Xb)) : ∃ o G', Exchange (pair a b) route G o G' := by rcases List.eq_nil_or_concat G with rfl | ⟨G₀, g, rfl⟩ · exact ⟨none, [], Exchange.silent _ (by simp [pair])⟩ rw [List.concat_eq_append] @@ -2212,7 +2212,7 @@ theorem exchange_pair (G : List (Two Xa Xb)) : ∃ o G', Exchange (pair a b) rou /-- If every internal cycle passes through `a`, and a measure on `a`'s histories drops at each reply of `a` that continues a cycle, the wiring of `[a, b]` converges, whatever `b` is. -/ -theorem converges_pair_of_measure : Converges (pair a b) route inj := +lemma converges_pair_of_measure : Converges (pair a b) route inj := converges_of_exchanges (exchange_pair hc ν hν) end Measure @@ -2220,7 +2220,7 @@ end Measure /-- **Convergence of an attachment.** If every internal cycle passes through `a`, and `a` has at most `n` consecutive replies that continue a cycle, the wiring of `[a, b]` converges, whatever `b` is. -/ -theorem converges_pair (hc : CyclesThrough P route) (hb : ∀ h, (a h).Dom → run P a h ≤ n) : +lemma converges_pair (hc : CyclesThrough P route) (hb : ∀ h, (a h).Dom → run P a h ≤ n) : Converges (pair a b) route inj := by refine converges_pair_of_measure hc (fun h => n - run P a h) (fun h x w hw hP => ?_) have hle := hb _ (Part.dom_iff_mem.mpr ⟨w, hw⟩) @@ -2229,7 +2229,7 @@ theorem converges_pair (hc : CyclesThrough P route) (hb : ∀ h, (a h).Dom → r /-- Each internal cycle consumes one of the remaining consecutive queries of `a`. A turn of `b` adds at most one reply before control returns to `a`. -/ -theorem Exchange.length_le_of_cycles (hc : CyclesThrough P route) +lemma Exchange.length_le_of_cycles (hc : CyclesThrough P route) (hb : ∀ h, (a h).Dom → run P a h ≤ n) {G o H} (l : Exchange (pair a b) route G o H) : ∀ G₀ x, G = G₀ ++ [x] → @@ -2283,7 +2283,7 @@ theorem Exchange.length_le_of_cycles (hc : CyclesThrough P route) /-- A finite exposed history needs at most `2n + 2` component replies per input. This concerns interaction length, independently of sample support. -/ -theorem Induces.length_le_of_cycles (hc : CyclesThrough P route) +lemma Induces.length_le_of_cycles (hc : CyclesThrough P route) (hb : ∀ h, (a h).Dom → run P a h ≤ n) {us o H} (r : Induces (pair a b) route inj us o H) : H.length ≤ (2 * n + 2) * us.length := by @@ -2297,7 +2297,7 @@ theorem Induces.length_le_of_cycles (hc : CyclesThrough P route) /-- **Convergence against a terminating system.** If every internal cycle passes through a terminating `a`, the wiring of `[a, b]` converges, whatever `b` is. -/ -theorem converges_pair_of_terminating (hc : CyclesThrough P route) (ha : Terminating a) : +lemma converges_pair_of_terminating (hc : CyclesThrough P route) (ha : Terminating a) : Converges (pair a b) route inj := by obtain ⟨μ, hμ⟩ := ha exact converges_pair_of_measure hc μ (fun h x w hw _ => hμ h x (Part.dom_iff_mem.mpr ⟨w, hw⟩)) @@ -2305,7 +2305,7 @@ theorem converges_pair_of_terminating (hc : CyclesThrough P route) (ha : Termina end Converge /-- If every input addresses the right constituent, only its history is used. -/ -theorem relabel_pair_right_only {A B C D E F : Type} (s : System A B) (t : System C D) +lemma relabel_pair_right_only {A B C D E F : Type} (s : System A B) (t : System C D) (ht : SilentAtEmpty t) (f : E → C) (g : Two B D → F) : relabel (pair s t) (fun x => ⟨some (), f x⟩) g = relabel t f (fun y => g ⟨some (), y⟩) := by @@ -2320,7 +2320,7 @@ theorem relabel_pair_right_only {A B C D E F : Type} (s : System A B) (t : Syste · simp only [relabel, List.concat_eq_append, List.map_append, List.map_singleton, pair_right, hm, Part.map_map, Function.comp_def] -theorem relabel_pair_left_only {A B C D E F : Type} (s : System A B) (t : System C D) +lemma relabel_pair_left_only {A B C D E F : Type} (s : System A B) (t : System C D) (hs : SilentAtEmpty s) (f : E → A) (g : Two B D → F) : relabel (pair s t) (fun x => ⟨none, f x⟩) g = relabel s f (fun y => g ⟨none, y⟩) := by diff --git a/src/RandomSystems/System/InterfaceSystem.lean b/src/RandomSystems/System/InterfaceSystem.lean index 13b527c..226380e 100644 --- a/src/RandomSystems/System/InterfaceSystem.lean +++ b/src/RandomSystems/System/InterfaceSystem.lean @@ -71,10 +71,10 @@ noncomputable def connect (s : InterfaceSystem I X Y) (C : Set I) (r : Routing C InterfaceSystem (Free C) (fun i => X i.1) (fun i => Y i.1) := interconnect s (connectRoute C r) (connectInj C) -theorem connectRoute_of_mem {C : Set I} (r : Routing C X Y) {p : Σ i, Y i} (h : p.1 ∈ C) : +lemma connectRoute_of_mem {C : Set I} (r : Routing C X Y) {p : Σ i, Y i} (h : p.1 ∈ C) : connectRoute C r p = .inr (liftC (r ⟨p.1, h⟩ p.2)) := dif_pos h -theorem connectRoute_of_not_mem {C : Set I} (r : Routing C X Y) {p : Σ i, Y i} (h : p.1 ∉ C) : +lemma connectRoute_of_not_mem {C : Set I} (r : Routing C X Y) {p : Σ i, Y i} (h : p.1 ∉ C) : connectRoute C r p = .inl ⟨⟨p.1, h⟩, p.2⟩ := dif_neg h /-! ### Vanishing at the level of labels (C1) -/ @@ -84,12 +84,12 @@ variable (C : Set I) (C' : Set (Free C)) /-- The labels connected by two successive connections. -/ def unionSet : Set I := C ∪ Subtype.val '' C' -theorem mem_unionSet_left {i : I} (h : i ∈ C) : i ∈ unionSet C C' := Or.inl h +lemma mem_unionSet_left {i : I} (h : i ∈ C) : i ∈ unionSet C C' := Or.inl h -theorem mem_unionSet_right {i : Free C} (h : i ∈ C') : i.1 ∈ unionSet C C' := +lemma mem_unionSet_right {i : Free C} (h : i ∈ C') : i.1 ∈ unionSet C C' := Or.inr ⟨i, h, rfl⟩ -theorem mem_of_mem_unionSet {i : I} (hu : i ∈ unionSet C C') (h : i ∉ C) : +lemma mem_of_mem_unionSet {i : I} (hu : i ∈ unionSet C C') (h : i ∉ C) : (⟨i, h⟩ : Free C) ∈ C' := by rcases hu with hp | ⟨q, hq, e⟩ · exact (h hp).elim @@ -116,13 +116,13 @@ nested connection. -/ def unionOut : (Σ i : Free (unionSet C C'), Y i.1) → Σ i : Free C', Y i.1.1 | ⟨i, y⟩ => ⟨⟨⟨i.1, fun h => i.2 (Or.inl h)⟩, fun h => i.2 (Or.inr ⟨_, h, rfl⟩)⟩, y⟩ -theorem unionRouting_left (r : Routing C X Y) +lemma unionRouting_left (r : Routing C X Y) (r' : Routing C' (fun i => X i.1) (fun i => Y i.1)) (p : unionSet C C') (h : p.1 ∈ C) (y : Y p) : unionRouting C C' r r' p y = ⟨⟨(r ⟨p.1, h⟩ y).1.1, mem_unionSet_left C C' (r ⟨p.1, h⟩ y).1.2⟩, (r ⟨p.1, h⟩ y).2⟩ := dif_pos h -theorem unionRouting_right (r : Routing C X Y) +lemma unionRouting_right (r : Routing C X Y) (r' : Routing C' (fun i => X i.1) (fun i => Y i.1)) (p : unionSet C C') (h : p.1 ∉ C) (y : Y p) : unionRouting C C' r r' p y = ⟨⟨(r' ⟨⟨p.1, h⟩, mem_of_mem_unionSet C C' p.2 h⟩ y).1.1.1, @@ -130,7 +130,7 @@ theorem unionRouting_right (r : Routing C X Y) (r' ⟨⟨p.1, h⟩, mem_of_mem_unionSet C C' p.2 h⟩ y).2⟩ := dif_neg h -theorem connectRoute_union_left (r : Routing C X Y) +lemma connectRoute_union_left (r : Routing C X Y) (r' : Routing C' (fun i => X i.1) (fun i => Y i.1)) {i : I} (h : i ∈ C) (y : Y i) : connectRoute (unionSet C C') (unionRouting C C' r r') ⟨i, y⟩ = .inr (liftC (r ⟨i, h⟩ y)) := by @@ -138,7 +138,7 @@ theorem connectRoute_union_left (r : Routing C X Y) rw [unionRouting_left C C' r r' ⟨i, _⟩ h] rfl -theorem connectRoute_union_right (r : Routing C X Y) +lemma connectRoute_union_right (r : Routing C X Y) (r' : Routing C' (fun i => X i.1) (fun i => Y i.1)) {i : I} (h : i ∉ C) (h' : (⟨i, h⟩ : Free C) ∈ C') (y : Y i) : connectRoute (unionSet C C') (unionRouting C C' r r') ⟨i, y⟩ = @@ -179,7 +179,7 @@ def freeCast (hC : ∀ i, i ∈ C₁ ↔ i ∈ C₂) : (Σ i : Free C₁, X i.1) | ⟨i, x⟩ => ⟨⟨i.1, fun h => i.2 ((hC _).2 h)⟩, x⟩ /-- Connecting along equal label sets with agreeing routings gives the same system. -/ -theorem connect_congr (s : InterfaceSystem I X Y) (r₁ : Routing C₁ X Y) (r₂ : Routing C₂ X Y) +lemma connect_congr (s : InterfaceSystem I X Y) (r₁ : Routing C₁ X Y) (r₂ : Routing C₂ X Y) (hC : ∀ i, i ∈ C₁ ↔ i ∈ C₂) (hr : ∀ i (h₁ : i ∈ C₁) (y : Y i), liftC (r₁ ⟨i, h₁⟩ y) = liftC (r₂ ⟨i, (hC i).1 h₁⟩ y)) : connect s C₁ r₁ = relabel (connect s C₂ r₂) (freeCast hC) (freeCast (fun i => (hC i).symm)) := by @@ -216,7 +216,7 @@ def swapFree : (Σ i : Free (freeSet C C'), X i.1.1) → Σ i : Free (freeSet C' C), X i.1.1 | ⟨⟨⟨i, h₁⟩, h₂⟩, x⟩ => ⟨⟨⟨i, h₂⟩, h₁⟩, x⟩ -theorem union_freeSet_iff (i : I) : +lemma union_freeSet_iff (i : I) : i ∈ unionSet C (freeSet C C') ↔ i ∈ unionSet C' (freeSet C' C) := by simp only [unionSet, freeSet, Set.mem_union, Set.mem_image, Set.mem_ofPred_eq, Subtype.exists, exists_and_right, exists_eq_right] @@ -335,7 +335,7 @@ noncomputable def pairRouting (p q : I) (c₁ : Y p → X q) (c₂ : Y q → X p · exact e ⟨⟨p, by simp⟩, c₂ (hq ▸ y)⟩ -theorem liftC_pairRouting_p (p q : I) (c₁ : Y p → X q) (c₂ : Y q → X p) +lemma liftC_pairRouting_p (p q : I) (c₁ : Y p → X q) (c₂ : Y q → X p) (p' : ({p, q} : Set I)) (h : p'.1 = p) (y : Y p') : liftC (pairRouting p q c₁ c₂ p' y) = ⟨q, c₁ (cast (congrArg Y h) y)⟩ := by obtain ⟨p', hp'⟩ := p' @@ -345,7 +345,7 @@ theorem liftC_pairRouting_p (p q : I) (c₁ : Y p → X q) (c₂ : Y q → X p) rw [dif_pos rfl] rfl -theorem liftC_pairRouting_q (p q : I) (hpq : q ≠ p) (c₁ : Y p → X q) (c₂ : Y q → X p) +lemma liftC_pairRouting_q (p q : I) (hpq : q ≠ p) (c₁ : Y p → X q) (c₂ : Y q → X p) (p' : ({p, q} : Set I)) (h : p'.1 = q) (y : Y p') : liftC (pairRouting p q c₁ c₂ p' y) = ⟨p, c₂ (cast (congrArg Y h) y)⟩ := by obtain ⟨p', hp'⟩ := p' @@ -380,10 +380,10 @@ abbrev setST : Set (Two I J) := {⟨none, p⟩, ⟨some (), q⟩} /-- The labels connected by `t ⋈_{q',x} u`. -/ abbrev setTU : Set (Two J L) := {⟨none, q'⟩, ⟨some (), x⟩} -theorem q'_free (hqq : q ≠ q') : (⟨some (), q'⟩ : Two I J) ∉ setST p q := by +lemma q'_free (hqq : q ≠ q') : (⟨some (), q'⟩ : Two I J) ∉ setST p q := by simp [setST, Ne.symm hqq] -theorem q_free (hqq : q ≠ q') : (⟨none, q⟩ : Two J L) ∉ setTU q' x := by +lemma q_free (hqq : q ≠ q') : (⟨none, q⟩ : Two J L) ∉ setTU q' x := by simp [setTU, hqq] /-- The labels connected in the second step of `(s ⋈ t) ⋈ u`. -/ @@ -394,18 +394,18 @@ abbrev setL (hqq : q ≠ q') : Set (Two (Free (setST p q)) L) := abbrev setR (hqq : q ≠ q') : Set (Two I (Free (setTU q' x))) := {⟨none, p⟩, ⟨some (), ⟨⟨none, q⟩, q_free q q' x hqq⟩⟩} -theorem notMem_ST_none {i : I} : (⟨none, i⟩ : Two I J) ∉ setST p q ↔ i ≠ p := by simp [setST] -theorem notMem_ST_some {j : J} : (⟨some (), j⟩ : Two I J) ∉ setST p q ↔ j ≠ q := by simp [setST] -theorem notMem_TU_none {j : J} : (⟨none, j⟩ : Two J L) ∉ setTU q' x ↔ j ≠ q' := by simp [setTU] -theorem notMem_TU_some {k : L} : (⟨some (), k⟩ : Two J L) ∉ setTU q' x ↔ k ≠ x := by simp [setTU] -theorem notMem_L_none (hqq : q ≠ q') {z : Free (setST p q)} : +lemma notMem_ST_none {i : I} : (⟨none, i⟩ : Two I J) ∉ setST p q ↔ i ≠ p := by simp [setST] +lemma notMem_ST_some {j : J} : (⟨some (), j⟩ : Two I J) ∉ setST p q ↔ j ≠ q := by simp [setST] +lemma notMem_TU_none {j : J} : (⟨none, j⟩ : Two J L) ∉ setTU q' x ↔ j ≠ q' := by simp [setTU] +lemma notMem_TU_some {k : L} : (⟨some (), k⟩ : Two J L) ∉ setTU q' x ↔ k ≠ x := by simp [setTU] +lemma notMem_L_none (hqq : q ≠ q') {z : Free (setST p q)} : (⟨none, z⟩ : Two _ L) ∉ setL p q q' x hqq ↔ z.1 ≠ ⟨some (), q'⟩ := by simp [setL, Subtype.ext_iff] -theorem notMem_L_some (hqq : q ≠ q') {k : L} : +lemma notMem_L_some (hqq : q ≠ q') {k : L} : (⟨some (), k⟩ : Two (Free (setST p q)) L) ∉ setL p q q' x hqq ↔ k ≠ x := by simp [setL] -theorem notMem_R_none (hqq : q ≠ q') {i : I} : +lemma notMem_R_none (hqq : q ≠ q') {i : I} : (⟨none, i⟩ : Two I _) ∉ setR p q q' x hqq ↔ i ≠ p := by simp [setR] -theorem notMem_R_some (hqq : q ≠ q') {z : Free (setTU q' x)} : +lemma notMem_R_some (hqq : q ≠ q') {z : Free (setTU q' x)} : (⟨some (), z⟩ : Two I _) ∉ setR p q q' x hqq ↔ z.1 ≠ ⟨none, q⟩ := by simp [setR, Subtype.ext_iff] @@ -514,15 +514,15 @@ def alongSet (ι : J → I) : Set (Two (Two O J) I) | ⟨some (), i⟩ => i ∈ Set.range ι | _ => False -theorem inside_mem_alongSet (ι : J → I) (j : J) : +lemma inside_mem_alongSet (ι : J → I) (j : J) : (⟨none, ⟨some (), j⟩⟩ : Two (Two O J) I) ∈ alongSet ι := trivial -theorem image_mem_alongSet (ι : J → I) (j : J) : +lemma image_mem_alongSet (ι : J → I) (j : J) : (⟨some (), ι j⟩ : Two (Two O J) I) ∈ alongSet (O := O) ι := ⟨j, rfl⟩ -theorem outside_not_mem_alongSet (ι : J → I) (o : O) : +lemma outside_not_mem_alongSet (ι : J → I) (o : O) : (⟨none, ⟨none, o⟩⟩ : Two (Two O J) I) ∉ alongSet ι := id -theorem sys_not_mem_alongSet (ι : J → I) {i : I} (h : i ∉ Set.range ι) : +lemma sys_not_mem_alongSet (ι : J → I) {i : I} (h : i ∉ Set.range ι) : (⟨some (), i⟩ : Two (Two O J) I) ∉ alongSet (O := O) ι := h -theorem sys_mem_alongSet_iff (ι : J → I) (i : I) : +lemma sys_mem_alongSet_iff (ι : J → I) (i : I) : (⟨some (), i⟩ : Two (Two O J) I) ∈ alongSet (O := O) ι ↔ i ∈ Set.range ι := Iff.rfl /-- Queries at inside port `j` go to interface `ι j`; replies at `ι j` go back to `j`. -/ @@ -534,11 +534,11 @@ noncomputable def alongRouting (ι : J → I) : cast (congrArg Y (Classical.choose_spec h).symm) y⟩ | ⟨⟨none, ⟨none, o⟩⟩, h⟩, _ => absurd h (outside_not_mem_alongSet ι o) -theorem liftC_alongRouting_inside (ι : J → I) (j : J) (h) (x : X (ι j)) : +lemma liftC_alongRouting_inside (ι : J → I) (j : J) (h) (x : X (ι j)) : liftC (alongRouting (U := U) (V := V) (Y := Y) ι ⟨⟨none, ⟨some (), j⟩⟩, h⟩ x) = ⟨⟨some (), ι j⟩, x⟩ := rfl -theorem liftC_alongRouting_image (ι : J → I) (hι : Function.Injective ι) (j : J) (h) +lemma liftC_alongRouting_image (ι : J → I) (hι : Function.Injective ι) (j : J) (h) (y : Y (ι j)) : liftC (alongRouting (U := U) (V := V) (X := X) ι ⟨⟨some (), ι j⟩, h⟩ y) = ⟨⟨none, ⟨some (), j⟩⟩, y⟩ := by @@ -563,17 +563,17 @@ abbrev alongInj (ι : J → I) := (splitIn (F := twoFam U (Y ∘ ι)) (G := X)) ∘ connectInj (X := twoFam (twoFam U (Y ∘ ι)) X) (alongSet (O := O) ι) -theorem attachAlong_eq (ι : J → I) (α : InsideOutsideSystem O J U V (X ∘ ι) (Y ∘ ι)) (R : InterfaceSystem I X Y) : +lemma attachAlong_eq (ι : J → I) (α : InsideOutsideSystem O J U V (X ∘ ι) (Y ∘ ι)) (R : InterfaceSystem I X Y) : attachAlong ι α R = interconnect (pair α R) (alongRoute ι) (alongInj ι) := by unfold attachAlong connect pairI rw [interconnect_relabel] -@[simp] theorem connectRoute_along_outside (ι : J → I) (o : O) (v : V o) : +@[simp] lemma connectRoute_along_outside (ι : J → I) (o : O) (v : V o) : connectRoute (alongSet (O := O) ι) (alongRouting (U := U) (X := X) (Y := Y) ι) ⟨⟨none, ⟨none, o⟩⟩, v⟩ = .inl ⟨⟨⟨none, ⟨none, o⟩⟩, outside_not_mem_alongSet ι o⟩, v⟩ := connectRoute_of_not_mem _ (outside_not_mem_alongSet ι o) -@[simp] theorem connectRoute_along_inside (ι : J → I) (j : J) (x : X (ι j)) : +@[simp] lemma connectRoute_along_inside (ι : J → I) (j : J) (x : X (ι j)) : connectRoute (alongSet (O := O) ι) (alongRouting (U := U) (V := V) (Y := Y) ι) ⟨⟨none, ⟨some (), j⟩⟩, x⟩ = .inr ⟨⟨some (), ι j⟩, x⟩ := connectRoute_of_mem _ (inside_mem_alongSet ι j) @@ -590,11 +590,11 @@ variable {I O J O' J' : Type} {X Y : I → Type} {U V : O → Type} {U' V' : O' @[reducible] def liftAlong (κ : J' → I) (ι : J → I) (hd : ∀ j, ι j ∉ Set.range κ) : J → Free (alongSet (O := O') κ) := fun j => ⟨⟨some (), ι j⟩, hd j⟩ -theorem liftAlong_injective (κ : J' → I) {ι : J → I} (hι : Function.Injective ι) +lemma liftAlong_injective (κ : J' → I) {ι : J → I} (hι : Function.Injective ι) (hd : ∀ j, ι j ∉ Set.range κ) : Function.Injective (liftAlong (O' := O') κ ι hd) := fun a b e => hι (by simpa [liftAlong] using congrArg (fun z => z.1) e) -theorem sys_mem_alongSet_lift_iff (κ : J' → I) (ι : J → I) (hd : ∀ j, ι j ∉ Set.range κ) +lemma sys_mem_alongSet_lift_iff (κ : J' → I) (ι : J → I) (hd : ∀ j, ι j ∉ Set.range κ) (i : I) (h) : (⟨some (), ⟨⟨some (), i⟩, h⟩⟩ : Two (Two O J) (Free (alongSet (O := O') κ))) ∈ alongSet (liftAlong κ ι hd) ↔ i ∈ Set.range ι := by simp only [alongSet, Set.mem_range, liftAlong] @@ -605,7 +605,7 @@ theorem sys_mem_alongSet_lift_iff (κ : J' → I) (ι : J → I) (hd : ∀ j, ι exact ⟨j, by simpa using e'⟩ · rintro ⟨j, rfl⟩; exact ⟨j, rfl⟩ -theorem liftC_alongRouting_lift (κ : J' → I) {ι : J → I} (hι : Function.Injective ι) +lemma liftC_alongRouting_lift (κ : J' → I) {ι : J → I} (hι : Function.Injective ι) (hd : ∀ j, ι j ∉ Set.range κ) (j : J) (h₁ h₂) (y : twoFam (twoFam V' (X ∘ κ)) Y ⟨some (), ι j⟩) : liftC (alongRouting (O := O) (U := U) (V := V) @@ -618,14 +618,14 @@ theorem liftC_alongRouting_lift (κ : J' → I) {ι : J → I} (hι : Function.I (Y := fun l : Free (alongSet (O := O') κ) => twoFam (twoFam V' (X ∘ κ)) Y l.1) (liftAlong κ ι hd) (liftAlong_injective κ hι hd) j h₂ y -theorem outside_not_mem_alongSet_lift (κ : J' → I) (ι : J → I) (hd : ∀ j, ι j ∉ Set.range κ) +lemma outside_not_mem_alongSet_lift (κ : J' → I) (ι : J → I) (hd : ∀ j, ι j ∉ Set.range κ) (o : O') (h) : (⟨some (), ⟨⟨none, ⟨none, o⟩⟩, h⟩⟩ : Two (Two O J) (Free (alongSet (O := O') κ))) ∉ alongSet (liftAlong κ ι hd) := by rintro ⟨j, e⟩ have e' := congrArg (fun z => z.1) e simp [liftAlong] at e' -theorem inside_not_mem_alongSet_lift (κ : J' → I) (ι : J → I) (hd : ∀ j, ι j ∉ Set.range κ) +lemma inside_not_mem_alongSet_lift (κ : J' → I) (ι : J → I) (hd : ∀ j, ι j ∉ Set.range κ) (k : J') (h) : (⟨some (), ⟨⟨none, ⟨some (), k⟩⟩, h⟩⟩ : Two (Two O J) (Free (alongSet (O := O') κ))) ∉ alongSet (liftAlong κ ι hd) := by rintro ⟨j, e⟩ @@ -763,7 +763,7 @@ noncomputable def protocol (α : InsideOutsideSystem O J U V (X ∘ ι) (Y ∘ variable {ι κ} (hι : ∀ j, ι j ∉ Set.range κ) -theorem jointAlong_injective (hι : ∀ j, ι j ∉ Set.range κ) (hιi : Function.Injective ι) +lemma jointAlong_injective (hι : ∀ j, ι j ∉ Set.range κ) (hιi : Function.Injective ι) (hκi : Function.Injective κ) : Function.Injective (jointAlong ι κ) := by rintro ⟨_ | ⟨⟨⟩⟩, a⟩ ⟨_ | ⟨⟨⟩⟩, b⟩ e @@ -772,7 +772,7 @@ theorem jointAlong_injective (hι : ∀ j, ι j ∉ Set.range κ) (hιi : Functi · exact absurd ⟨a, e⟩ (hι b) · simp [hκi e] -theorem sys_mem_alongSet_joint_iff (i : I) : +lemma sys_mem_alongSet_joint_iff (i : I) : (⟨some (), i⟩ : Two (Two (Two O O') (Two J J')) I) ∈ alongSet (jointAlong ι κ) ↔ i ∈ Set.range ι ∨ i ∈ Set.range κ := by show i ∈ Set.range (jointAlong ι κ) ↔ _ @@ -821,7 +821,7 @@ def protoAppOut : /-- **Protocol application.** Applying a protocol of two converters at once is applying them one after the other, after the canonical relabeling. -/ -theorem attachAlong_protocol (hιi : Function.Injective ι) (hκi : Function.Injective κ) +lemma attachAlong_protocol (hιi : Function.Injective ι) (hκi : Function.Injective κ) (α : InsideOutsideSystem O J U V (X ∘ ι) (Y ∘ ι)) (β : InsideOutsideSystem O' J' U' V' (X ∘ κ) (Y ∘ κ)) (R : InterfaceSystem I X Y) (hβR : Converges (pair β R) (alongRoute κ) (alongInj κ)) : attachAlong (jointAlong ι κ) (protocol ι κ α β) R = @@ -917,10 +917,10 @@ def closeSet (I : Type) : Set (Two (DPort I) I) | ⟨some (), _⟩ => True | _ => False -theorem res_mem_closeSet (i : I) : (⟨none, .res i⟩ : Two (DPort I) I) ∈ closeSet I := trivial -theorem sys_mem_closeSet (i : I) : (⟨some (), i⟩ : Two (DPort I) I) ∈ closeSet I := trivial -theorem start_not_mem_closeSet : (⟨none, .start⟩ : Two (DPort I) I) ∉ closeSet I := id -theorem dec_not_mem_closeSet : (⟨none, .dec⟩ : Two (DPort I) I) ∉ closeSet I := id +lemma res_mem_closeSet (i : I) : (⟨none, .res i⟩ : Two (DPort I) I) ∈ closeSet I := trivial +lemma sys_mem_closeSet (i : I) : (⟨some (), i⟩ : Two (DPort I) I) ∈ closeSet I := trivial +lemma start_not_mem_closeSet : (⟨none, .start⟩ : Two (DPort I) I) ∉ closeSet I := id +lemma dec_not_mem_closeSet : (⟨none, .dec⟩ : Two (DPort I) I) ∉ closeSet I := id /-- Queries at `res i` go to interface `i`; replies at `i` go back to `res i`. -/ def closeRouting : Routing (closeSet I) (twoFam (dIn Y) X) (twoFam (dOut X) Y) @@ -933,10 +933,10 @@ def closeRouting : Routing (closeSet I) (twoFam (dIn Y) X) (twoFam (dOut X) Y) noncomputable def close (D : DDD I X Y) (R : InterfaceSystem I X Y) := connect (pairI D R) (closeSet I) closeRouting -theorem liftC_closeRouting_res (i : I) (h) (x : X i) : +lemma liftC_closeRouting_res (i : I) (h) (x : X i) : liftC (closeRouting (X := X) (Y := Y) ⟨⟨none, .res i⟩, h⟩ x) = ⟨⟨some (), i⟩, x⟩ := rfl -theorem liftC_closeRouting_sys (i : I) (h) (y : Y i) : +lemma liftC_closeRouting_sys (i : I) (h) (y : Y i) : liftC (closeRouting (X := X) (Y := Y) ⟨⟨some (), i⟩, h⟩ y) = ⟨⟨none, .res i⟩, y⟩ := rfl end DDD @@ -952,12 +952,12 @@ noncomputable def replyLabel {K : Type} {F G : K → Type} (s : InterfaceSystem Option K := if hd : (s h).Dom then some ((s h).get hd).1 else none -theorem replyLabel_of_mem {K : Type} {F G : K → Type} (s : InterfaceSystem K F G) {h} {y : Σ l, G l} +lemma replyLabel_of_mem {K : Type} {F G : K → Type} (s : InterfaceSystem K F G) {h} {y : Σ l, G l} (hy : y ∈ s h) : replyLabel s h = some y.1 := by have hd : (s h).Dom := Part.dom_iff_mem.mpr ⟨y, hy⟩ simp [replyLabel, hd, Part.get_eq_of_mem hy hd] -theorem replyLabel_trim {K : Type} {F G : K → Type} (s : InterfaceSystem K F G) {h} (hr : Reach s h) : +lemma replyLabel_trim {K : Type} {F G : K → Type} (s : InterfaceSystem K F G) {h} (hr : Reach s h) : replyLabel (trim s) h = replyLabel s h := by simp [replyLabel, trim, hr] @@ -985,13 +985,13 @@ def pcSet (I J : Type) : Set (Two (DPort (Two I J)) J) | ⟨some (), _⟩ => True | _ => False -theorem pc_res_mem (k : J) : (⟨none, .res ⟨some (), k⟩⟩ : Two (DPort (Two I J)) J) ∈ pcSet I J := +lemma pc_res_mem (k : J) : (⟨none, .res ⟨some (), k⟩⟩ : Two (DPort (Two I J)) J) ∈ pcSet I J := trivial -theorem pc_sys_mem (k : J) : (⟨some (), k⟩ : Two (DPort (Two I J)) J) ∈ pcSet I J := trivial -theorem pc_res_none_not_mem (i : I) : +lemma pc_sys_mem (k : J) : (⟨some (), k⟩ : Two (DPort (Two I J)) J) ∈ pcSet I J := trivial +lemma pc_res_none_not_mem (i : I) : (⟨none, .res ⟨none, i⟩⟩ : Two (DPort (Two I J)) J) ∉ pcSet I J := id -theorem pc_start_not_mem : (⟨none, .start⟩ : Two (DPort (Two I J)) J) ∉ pcSet I J := id -theorem pc_dec_not_mem : (⟨none, .dec⟩ : Two (DPort (Two I J)) J) ∉ pcSet I J := id +lemma pc_start_not_mem : (⟨none, .start⟩ : Two (DPort (Two I J)) J) ∉ pcSet I J := id +lemma pc_dec_not_mem : (⟨none, .dec⟩ : Two (DPort (Two I J)) J) ∉ pcSet I J := id /-- Queries of `D` towards `S` go to `S`, and back. -/ def pcRouting : Routing (pcSet I J) (twoFam (dIn (twoFam Y₁ Y₂)) X₂) (twoFam (dOut (twoFam X₁ X₂)) Y₂) @@ -1022,11 +1022,11 @@ noncomputable def partialClose (D : DDD (Two I J) (twoFam X₁ X₂) (twoFam Y (S : InterfaceSystem J X₂ Y₂) : DDD I X₁ Y₁ := relabel (connect (pairI D S) (pcSet I J) pcRouting) pcIn pcOut -theorem liftC_pcRouting_res (k : J) (h) (x : X₂ k) : +lemma liftC_pcRouting_res (k : J) (h) (x : X₂ k) : liftC (pcRouting (X₁ := X₁) (Y₁ := Y₁) (Y₂ := Y₂) ⟨⟨none, .res ⟨some (), k⟩⟩, h⟩ x) = ⟨⟨some (), k⟩, x⟩ := rfl -theorem liftC_pcRouting_sys (k : J) (h) (y : Y₂ k) : +lemma liftC_pcRouting_sys (k : J) (h) (y : Y₂ k) : liftC (pcRouting (X₁ := X₁) (Y₁ := Y₁) (X₂ := X₂) ⟨⟨some (), k⟩, h⟩ y) = ⟨⟨none, .res ⟨some (), k⟩⟩, y⟩ := rfl @@ -1047,7 +1047,7 @@ def e2Out : (Σ l : Free (closeSet I), twoFam (dOut X₁) Y₁ l.1) → | ⟨⟨⟨some (), i⟩, h⟩, _⟩ => absurd (sys_mem_closeSet i) h /-- Every internal cycle of `D[·, S]` passes through `D`: a reply of `S` goes back to `D`. -/ -theorem pc_cyclesThrough : +lemma pc_cyclesThrough : CyclesThrough (fun _ => True) (fun y : Two (Σ p, dOut (twoFam X₁ X₂) p) (Σ k, Y₂ k) => Sum.map id splitIn (connectRoute (pcSet I J) (pcRouting (X₁ := X₁) (Y₁ := Y₁) (X₂ := X₂) (Y₂ := Y₂)) (joinOut y))) := by @@ -1116,7 +1116,7 @@ def pcInj : (Σ p : DPort I, dIn Y₁ p) → Two (Σ p, dIn (twoFam Y₁ Y₂) p | ⟨.dec, e⟩ => e.elim | ⟨.res i, y⟩ => ⟨none, ⟨.res ⟨none, i⟩, y⟩⟩ -theorem partialClose_eq (D : DDD (Two I J) (twoFam X₁ X₂) (twoFam Y₁ Y₂)) (S : InterfaceSystem J X₂ Y₂) : +lemma partialClose_eq (D : DDD (Two I J) (twoFam X₁ X₂) (twoFam Y₁ Y₂)) (S : InterfaceSystem J X₂ Y₂) : partialClose D S = interconnect (pair D S) pcRoute pcInj := by unfold partialClose connect pairI rw [relabel_interconnect, interconnect_relabel] @@ -1144,7 +1144,7 @@ def liftLab : DPort I → DPort (Two I J) variable {D : DDD (Two I J) (twoFam X₁ X₂) (twoFam Y₁ Y₂)} {S : InterfaceSystem J X₂ Y₂} -theorem pc_exchange {G o G'} (l : Exchange (pair D S) pcRoute G o G') : +lemma pc_exchange {G o G'} (l : Exchange (pair D S) pcRoute G o G') : ∀ out, o = some out → ((∃ G₁ x, G = G₁ ++ [⟨none, x⟩] ∧ Reach D (restrict none G₁)) ∨ (∃ G₁ x, G = G₁ ++ [⟨some (), x⟩] ∧ Reach D (restrict none G₁) ∧ @@ -1202,7 +1202,7 @@ def PcInv (u : List (Σ p : DPort I, dIn Y₁ p)) ∀ l, replyLabel (interconnect (pair D S) pcRoute pcInj) u = some l → replyLabel D (restrict none H) = some (liftLab (J := J) l) -theorem pc_step (hD : IsDDD D) {u H} (inv : PcInv D S u H) {z : Σ p : DPort I, dIn Y₁ p} +lemma pc_step (hD : IsDDD D) {u H} (inv : PcInv D S u H) {z : Σ p : DPort I, dIn Y₁ p} (hr : Reach (interconnect (pair D S) pcRoute pcInj) (u ++ [z])) : (u = [] ↔ z.1 = .start) ∧ (∀ i, replyLabel (interconnect (pair D S) pcRoute pcInj) u = some (.res i) → z.1 = .res i) ∧ @@ -1241,7 +1241,7 @@ theorem pc_step (hD : IsDDD D) {u H} (inv : PcInv D S u H) {z : Σ p : DPort I, cases hl exact h2 -theorem length_le_restrict_none {A B Xa Xb Y : Type} {s : System (Two Xa Xb) Y} +lemma length_le_restrict_none {A B Xa Xb Y : Type} {s : System (Two Xa Xb) Y} {route : Y → B ⊕ Two Xa Xb} {inj : A → Two Xa Xb} (hinj : ∀ a, ∃ x, inj a = ⟨none, x⟩) {u o H} (r : Induces s route inj u o H) : u.length ≤ (restrict none H).length := by induction r with @@ -1257,7 +1257,7 @@ theorem length_le_restrict_none {A B Xa Xb Y : Type} {s : System (Two Xa Xb) Y} /-- **`D[·, S]` is an environment** (spec §5.6): the reachable part of an environment with any system absorbed is an environment. The query bound is the bound of `D`. -/ -theorem partialClose_isDDD (hD : IsDDD D) : IsDDD (trim (partialClose D S)) := by +lemma partialClose_isDDD (hD : IsDDD D) : IsDDD (trim (partialClose D S)) := by rw [partialClose_eq] set γ := interconnect (pair D S) pcRoute pcInj have inv : ∀ u, Reach γ u → ∃ H, PcInv D S u H := by diff --git a/src/RandomSystems/System/Observation.lean b/src/RandomSystems/System/Observation.lean index 2d629bd..2a55e34 100644 --- a/src/RandomSystems/System/Observation.lean +++ b/src/RandomSystems/System/Observation.lean @@ -38,7 +38,7 @@ variable {I : Type} {X Y : I → Type} /-- A reply of the system, read as an input of the environment. -/ def envIn (y : Σ i, Y i) : Σ p, dIn Y p := ⟨.res y.1, y.2⟩ -theorem envIn_injective : Function.Injective (envIn (Y := Y)) := by +lemma envIn_injective : Function.Injective (envIn (Y := Y)) := by rintro ⟨i, y⟩ ⟨i', y'⟩ h simp only [envIn, Sigma.mk.injEq, DPort.res.injEq] at h obtain ⟨rfl, h⟩ := h @@ -57,7 +57,7 @@ def query : (Σ p, dOut X p) → Option (Σ i, X i) noncomputable def envOf (D : DDD I X Y) : List (Σ i, Y i) →. Σ i, X i := fun ys => (D (dHist ys)).bind fun o => (query o : Part _) -theorem mem_envOf {D : DDD I X Y} {ys x} : x ∈ envOf D ys ↔ ⟨.res x.1, x.2⟩ ∈ D (dHist ys) := by +lemma mem_envOf {D : DDD I X Y} {ys x} : x ∈ envOf D ys ↔ ⟨.res x.1, x.2⟩ ∈ D (dHist ys) := by constructor · intro h obtain ⟨o, ho, hq⟩ := Part.mem_bind_iff.mp h @@ -85,7 +85,7 @@ def closeInj : (Σ l : Free (closeSet I), twoFam (dIn Y) X l.1) → Two (Σ p, d | ⟨⟨⟨none, .res i⟩, h⟩, _⟩ => absurd (res_mem_closeSet i) h | ⟨⟨⟨some (), i⟩, h⟩, _⟩ => absurd (sys_mem_closeSet i) h -theorem close_eq (D : DDD I X Y) (R : InterfaceSystem I X Y) : +lemma close_eq (D : DDD I X Y) (R : InterfaceSystem I X Y) : close D R = interconnect (pair D R) closeRoute closeInj := by unfold close connect pairI rw [interconnect_relabel] @@ -117,7 +117,7 @@ def decOut (b : Bool) : Σ l : Free (closeSet I), twoFam (dOut X) Y l.1 := ⟨⟨⟨none, .dec⟩, dec_not_mem_closeSet⟩, b⟩ /-- Every output of `D ▹ R` is a decision. -/ -theorem eq_decOut (z : Σ l : Free (closeSet I), twoFam (dOut X) Y l.1) : ∃ b, z = decOut b := by +lemma eq_decOut (z : Σ l : Free (closeSet I), twoFam (dOut X) Y l.1) : ∃ b, z = decOut b := by rcases z with ⟨⟨⟨_ | ⟨⟨⟩⟩, l⟩, hl⟩, v⟩ · rcases l with _ | _ | i · exact v.elim @@ -125,7 +125,7 @@ theorem eq_decOut (z : Σ l : Free (closeSet I), twoFam (dOut X) Y l.1) : ∃ b, · exact absurd (res_mem_closeSet i) hl · exact absurd (sys_mem_closeSet l) hl -theorem decOut_injective : Function.Injective (decOut (X := X) (Y := Y)) := by +lemma decOut_injective : Function.Injective (decOut (X := X) (Y := Y)) := by intro b b' h simpa [decOut] using h @@ -140,7 +140,7 @@ def inter : List (Σ i, X i) → List (Σ i, Y i) → List (Two (Σ p, dIn Y p) def hist (xs : List (Σ i, X i)) (ys : List (Σ i, Y i)) : List (Two (Σ p, dIn Y p) (Σ i, X i)) := ⟨none, ⟨.start, ()⟩⟩ :: inter xs ys -theorem inter_snoc {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.length = ys.length) +lemma inter_snoc {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.length = ys.length) (x : Σ i, X i) (y : Σ i, Y i) : inter (xs ++ [x]) (ys ++ [y]) = inter xs ys ++ [⟨some (), x⟩, ⟨none, envIn y⟩] := by induction xs generalizing ys with @@ -153,12 +153,12 @@ theorem inter_snoc {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.leng | nil => simp at hl | cons y' ys => simp [inter, ih (by simpa using hl)] -theorem hist_snoc {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.length = ys.length) +lemma hist_snoc {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.length = ys.length) (x : Σ i, X i) (y : Σ i, Y i) : hist (xs ++ [x]) (ys ++ [y]) = hist xs ys ++ [⟨some (), x⟩] ++ [⟨none, envIn y⟩] := by simp [hist, inter_snoc hl] -theorem restrict_none_inter {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} +lemma restrict_none_inter {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.length = ys.length) : restrict none (inter xs ys) = ys.map envIn := by induction xs generalizing ys with | nil => @@ -173,7 +173,7 @@ theorem restrict_none_inter {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} restrict_cons_self, ih (by simpa using hl)] rfl -theorem restrict_some_inter {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} +lemma restrict_some_inter {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.length = ys.length) : restrict (some ()) (inter xs ys) = xs := by induction xs generalizing ys with | nil => cases ys <;> rfl @@ -184,15 +184,15 @@ theorem restrict_some_inter {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} rw [inter, restrict_cons_self, restrict_cons_ne (k := some ()) (k' := (none : Option Unit)) (by simp), ih (by simpa using hl)] -theorem restrict_none_hist {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} +lemma restrict_none_hist {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.length = ys.length) : restrict none (hist xs ys) = dHist ys := by simp [hist, dHist, restrict_none_inter hl] -theorem restrict_some_hist {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} +lemma restrict_some_hist {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.length = ys.length) : restrict (some ()) (hist xs ys) = xs := by simp [hist, restrict_some_inter hl] -theorem hist_last {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.length = ys.length) : +lemma hist_last {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.length = ys.length) : ∃ G a, hist xs ys = G ++ [⟨none, a⟩] := by rcases List.eq_nil_or_concat xs with rfl | ⟨xs', x, rfl⟩ · cases ys with @@ -205,7 +205,7 @@ theorem hist_last {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.lengt variable {D : DDD I X Y} {R : InterfaceSystem I X Y} -theorem pair_hist {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.length = ys.length) : +lemma pair_hist {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.length = ys.length) : pair D R (hist xs ys) = (D (dHist ys)).map (Sigma.mk none) := by obtain ⟨G, a, e⟩ := hist_last hl have hr := restrict_none_hist (Y := Y) hl @@ -214,7 +214,7 @@ theorem pair_hist {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.lengt simp only [restrict_append, restrict_two_none_cons_none, restrict_nil] at hr rw [hr] -theorem pair_hist_query {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} +lemma pair_hist_query {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} (hl : xs.length = ys.length) (x : Σ i, X i) : pair D R (hist xs ys ++ [⟨some (), x⟩]) = (R (xs ++ [x])).map (Sigma.mk (some ())) := by rw [pair_right, restrict_some_hist hl] @@ -223,7 +223,7 @@ theorem pair_hist_query {xs : List (Σ i, X i)} {ys : List (Σ i, Y i)} /-- Along an exchange of `D ▹ R` that starts on a transcript, a decision is a decision of `D` at the end of a longer transcript. -/ -theorem close_exchange {G o G'} (l : Exchange (pair D R) closeRoute G o G') : +lemma close_exchange {G o G'} (l : Exchange (pair D R) closeRoute G o G') : ∀ b, o = some (decOut b) → ∀ xs ys, Transcript R (envOf D) xs ys → (G = hist xs ys ∨ ∃ x, x ∈ envOf D ys ∧ G = hist xs ys ++ [⟨some (), x⟩]) → ∃ xs' ys', Transcript R (envOf D) xs' ys' ∧ ⟨.dec, b⟩ ∈ D (dHist ys') := by @@ -266,7 +266,7 @@ theorem close_exchange {G o G'} (l : Exchange (pair D R) closeRoute G o G') : rfl /-- An exchange from a later point of a transcript is an exchange from its start. -/ -theorem exchange_of_transcript {xs ys} (tr : Transcript R (envOf D) xs ys) : +lemma exchange_of_transcript {xs ys} (tr : Transcript R (envOf D) xs ys) : ∀ {o G'}, Exchange (pair D R) closeRoute (hist xs ys) o G' → Exchange (pair D R) closeRoute (hist [] []) o G' := by induction tr with @@ -281,7 +281,7 @@ theorem exchange_of_transcript {xs ys} (tr : Transcript R (envOf D) xs ys) : · refine Exchange.feed _ ⟨some (), y⟩ ⟨none, envIn y⟩ _ _ ?_ rfl l rw [pair_hist_query hl]; exact Part.mem_map _ hy -theorem induces_start {o H} : +lemma induces_start {o H} : Induces (pair D R) closeRoute closeInj [startIn] o H ↔ Exchange (pair D R) closeRoute (hist [] []) o H := by rw [show ([startIn] : List (Σ l : Free (closeSet I), twoFam (dIn Y) X l.1)) = [] ++ [startIn] @@ -295,7 +295,7 @@ theorem induces_start {o H} : /-- **The decision of `D ▹ R`** is the decision of `D` at the end of a transcript of `R` with `D`. -/ -theorem close_decision (b : Bool) : +lemma close_decision (b : Bool) : decOut b ∈ close D R [startIn] ↔ ∃ xs ys, Transcript R (envOf D) xs ys ∧ ⟨.dec, b⟩ ∈ D (dHist ys) := by rw [close_eq, mem_interconnect] @@ -308,7 +308,7 @@ theorem close_decision (b : Bool) : exact Part.mem_map _ hd /-- The decision depends only on the transcripts. -/ -theorem close_start_eq {S : InterfaceSystem I X Y} +lemma close_start_eq {S : InterfaceSystem I X Y} (h : ∀ xs ys, Transcript R (envOf D) xs ys ↔ Transcript S (envOf D) xs ys) : close D R [startIn] = close D S [startIn] := by apply Part.ext @@ -326,7 +326,7 @@ def Compatible (D : DDD I X Y) (R : InterfaceSystem I X Y) : Prop := (D (dHist ys)).Dom ∧ ∀ x, x ∈ envOf D ys → (R (xs ++ [x])).Dom /-- From every point of a transcript, the exchange of a defined decision goes on. -/ -theorem exchange_along {xs ys} (tr : Transcript R (envOf D) xs ys) : +lemma exchange_along {xs ys} (tr : Transcript R (envOf D) xs ys) : ∀ {c G'}, Exchange (pair D R) closeRoute (hist [] []) (some c) G' → ∃ c' G'', Exchange (pair D R) closeRoute (hist xs ys) (some c') G'' := by induction tr with @@ -362,7 +362,7 @@ theorem exchange_along {xs ys} (tr : Transcript R (envOf D) xs ys) : /-- **The decision is defined iff the environment is compatible with the system** (spec §5.6), for a finite environment. -/ -theorem close_dom_iff_compatible {n : ℕ} (hD : Finite n D) : +lemma close_dom_iff_compatible {n : ℕ} (hD : Finite n D) : (close D R [startIn]).Dom ↔ Compatible D R := by rw [close_eq] constructor @@ -433,7 +433,7 @@ variable {I : Type} {X Y : I → Type} def RepliesAtQueriedInterface (R : InterfaceSystem I X Y) : Prop := ∀ h a y, y ∈ R (h ++ [a]) → y.1 = a.1 /-- A change of interface vocabulary preserves responding interfaces. -/ -theorem RepliesAtQueriedInterface.relabel {J : Type} {U V : J → Type} {R : InterfaceSystem I X Y} (hr : RepliesAtQueriedInterface R) +lemma RepliesAtQueriedInterface.relabel {J : Type} {U V : J → Type} {R : InterfaceSystem I X Y} (hr : RepliesAtQueriedInterface R) (f : (Σ j, U j) → (Σ i, X i)) (g : (Σ i, Y i) → (Σ j, V j)) (hl : ∀ x y, y.1 = (f x).1 → (g y).1 = x.1) : RepliesAtQueriedInterface (relabel R f g) := by intro h x y hy @@ -463,7 +463,7 @@ noncomputable def probe (h : List (Σ i, X i)) (P : List (Σ i, Y i) → Bool) : variable {h : List (Σ i, X i)} {P : List (Σ i, Y i) → Bool} -theorem probe_dHist {ys : List (Σ i, Y i)} (hv : Fits h ys) : +lemma probe_dHist {ys : List (Σ i, Y i)} (hv : Fits h ys) : probe h P (dHist ys) = probeReply h P ys := by have hex : ∃ ys', ys.map envIn = ys'.map envIn ∧ Fits h ys' := ⟨ys, rfl, hv⟩ simp only [probe, dHist, dif_pos hex] @@ -471,7 +471,7 @@ theorem probe_dHist {ys : List (Σ i, Y i)} (hv : Fits h ys) : (List.map_injective_iff.mpr envIn_injective (Classical.choose_spec hex).1).symm rw [e] -theorem probe_dom {w} (hd : (probe (Y := Y) h P w).Dom) : ∃ ys, w = dHist ys ∧ Fits h ys := by +lemma probe_dom {w} (hd : (probe (Y := Y) h P w).Dom) : ∃ ys, w = dHist ys ∧ Fits h ys := by match w, hd with | ⟨.start, ()⟩ :: ws, hd => simp only [probe] at hd @@ -483,7 +483,7 @@ theorem probe_dom {w} (hd : (probe (Y := Y) h P w).Dom) : ∃ ys, w = dHist ys | ⟨.dec, e⟩ :: _, _ => exact e.elim | ⟨.res _, _⟩ :: _, hd => exact hd.elim -theorem Fits.of_snoc {ys : List (Σ i, Y i)} {y} (hv : Fits h (ys ++ [y])) : +lemma Fits.of_snoc {ys : List (Σ i, Y i)} {y} (hv : Fits h (ys ++ [y])) : Fits h ys ∧ ∃ q, h[ys.length]? = some q ∧ y.1 = q.1 := by obtain ⟨hle, hm⟩ := hv simp only [List.length_append, List.length_singleton] at hle hm @@ -494,7 +494,7 @@ theorem Fits.of_snoc {ys : List (Σ i, Y i)} {y} (hv : Fits h (ys ++ [y])) : simp only [List.cons.injEq, and_true] at h2 exact ⟨⟨by omega, h1⟩, _, List.getElem?_eq_getElem hlt, h2⟩ -theorem Fits.snoc {ys : List (Σ i, Y i)} (hv : Fits h ys) {q} (hq : h[ys.length]? = some q) +lemma Fits.snoc {ys : List (Σ i, Y i)} (hv : Fits h ys) {q} (hq : h[ys.length]? = some q) {y : Σ i, Y i} (hy : y.1 = q.1) : Fits h (ys ++ [y]) := by obtain ⟨hle, hm⟩ := hv have hlt : ys.length < h.length := (List.getElem?_eq_some_iff.mp hq).1 @@ -503,7 +503,7 @@ theorem Fits.snoc {ys : List (Σ i, Y i)} (hv : Fits h ys) {q} (hq : h[ys.length rw [List.length_append, List.length_singleton, List.take_add_one, List.getElem?_eq_getElem hlt] simp only [List.map_append, List.map_cons, List.map_nil, Option.toList_some, hm, hy] -theorem dHist_snoc_inv {w : List (Σ p, dIn Y p)} {z} {ys' : List (Σ i, Y i)} +lemma dHist_snoc_inv {w : List (Σ p, dIn Y p)} {z} {ys' : List (Σ i, Y i)} (e : w ++ [z] = dHist ys') : (w = [] ∧ z = ⟨.start, ()⟩) ∨ ∃ ys y, ys' = ys ++ [y] ∧ w = dHist ys ∧ z = envIn y := by rcases List.eq_nil_or_concat ys' with rfl | ⟨ys, y, rfl⟩ @@ -516,15 +516,15 @@ theorem dHist_snoc_inv {w : List (Σ p, dIn Y p)} {z} {ys' : List (Σ i, Y i)} obtain ⟨h1, h2⟩ := List.append_inj' this rfl exact ⟨ys, y, List.concat_eq_append .., h1, by simpa using h2⟩ -theorem dHist_ne_nil (ys : List (Σ i, Y i)) : dHist ys ≠ [] := by simp [dHist] +lemma dHist_ne_nil (ys : List (Σ i, Y i)) : dHist ys ≠ [] := by simp [dHist] /-- The probe is a DDD. -/ -theorem probe_finite : Finite (h.length + 1) (probe (Y := Y) h P) := by +lemma probe_finite : Finite (h.length + 1) (probe (Y := Y) h P) := by intro w hd obtain ⟨ys, rfl, hv⟩ := probe_dom hd simp [dHist]; exact hv.1 -theorem probe_isDDD : IsDDD (probe (Y := Y) h P) := by +lemma probe_isDDD : IsDDD (probe (Y := Y) h P) := by refine ⟨?_, ⟨h.length + 1, probe_finite⟩, ?_, ?_, ?_⟩ · simp [SilentAtEmpty, probe] · intro w z hr @@ -549,7 +549,7 @@ theorem probe_isDDD : IsDDD (probe (Y := Y) h P) := by rw [replyLabel, probe_dHist hv] at hl simp [probeReply, hq] at hl -theorem fixedQueries_take {R : InterfaceSystem I X Y} {H : List (Σ i, X i)} {xs ys} +lemma fixedQueries_take {R : InterfaceSystem I X Y} {H : List (Σ i, X i)} {xs ys} (tr : Transcript R (fixedQueries H) xs ys) : xs = H.take xs.length := by induction tr with | nil => simp @@ -559,7 +559,7 @@ theorem fixedQueries_take {R : InterfaceSystem I X Y} {H : List (Σ i, X i)} {xs rw [List.length_append, List.length_singleton, List.take_add_one, hl, hx, ← hl, ← ih] rfl -theorem probe_transcript_fixed {R : InterfaceSystem I X Y} (hR : RepliesAtQueriedInterface R) {xs ys} +lemma probe_transcript_fixed {R : InterfaceSystem I X Y} (hR : RepliesAtQueriedInterface R) {xs ys} (tr : Transcript R (envOf (probe h P)) xs ys) : Transcript R (fixedQueries h) xs ys ∧ Fits h ys := by induction tr with | nil => exact ⟨Transcript.nil, by simp [Fits]⟩ @@ -579,7 +579,7 @@ theorem probe_transcript_fixed {R : InterfaceSystem I X Y} (hR : RepliesAtQuerie exact hv.snoc hq (hR _ _ _ hy) · simp at hx -theorem fixed_probe_transcript {R : InterfaceSystem I X Y} (hR : RepliesAtQueriedInterface R) {xs ys} +lemma fixed_probe_transcript {R : InterfaceSystem I X Y} (hR : RepliesAtQueriedInterface R) {xs ys} (tr : Transcript R (fixedQueries h) xs ys) : Transcript R (envOf (probe h P)) xs ys ∧ Fits h ys := by induction tr with @@ -593,7 +593,7 @@ theorem fixed_probe_transcript {R : InterfaceSystem I X Y} (hR : RepliesAtQuerie /-- The decisions of the probe on a resource: it decides `P` of the replies to `h`, exactly when `h` is answered. -/ -theorem probe_decision {R : InterfaceSystem I X Y} (hR : RepliesAtQueriedInterface R) (b : Bool) : +lemma probe_decision {R : InterfaceSystem I X Y} (hR : RepliesAtQueriedInterface R) (b : Bool) : decOut b ∈ close (probe h P) R [startIn] ↔ ∃ ys, Transcript R (fixedQueries h) h ys ∧ b = P ys := by rw [close_decision] @@ -677,7 +677,7 @@ def swapper : InterfaceSystem Bool (fun _ => Unit) (fun _ => Unit) /-- Never answers. -/ def mute : InterfaceSystem Bool (fun _ => Unit) (fun _ => Unit) := fun _ => Part.none -theorem swapper_transcript {e xs ys} (tr : Transcript swapper e xs ys) : +lemma swapper_transcript {e xs ys} (tr : Transcript swapper e xs ys) : ys = [] ∨ ∃ x y, xs = [x] ∧ ys = [y] ∧ x ∈ e [] ∧ y ∈ swapper [x] := by cases tr with | nil => exact Or.inl rfl @@ -691,14 +691,14 @@ theorem swapper_transcript {e xs ys} (tr : Transcript swapper e xs ys) : rcases x₀ with ⟨i, ⟨⟩⟩ simp [swapper] at hy -theorem mute_transcript {e xs ys} (tr : Transcript mute e xs ys) : ys = [] := by +lemma mute_transcript {e xs ys} (tr : Transcript mute e xs ys) : ys = [] := by cases tr with | nil => rfl | snoc _ _ hy => simp [mute] at hy /-- **DDDs do not see replies at another interface**: `swapper` and `mute` are not behaviourally equal, but every DDD decides the same with both. -/ -theorem dde_blind_beyond_resources : +lemma dde_blind_beyond_resources : ¬ swapper ≈ₛ mute ∧ ∀ D : DDD Bool (fun _ => Unit) (fun _ => Unit), IsDDD D → close D swapper [startIn] = close D mute [startIn] := by diff --git a/src/RandomSystems/System/Replies.lean b/src/RandomSystems/System/Replies.lean index 027a58b..b13960f 100644 --- a/src/RandomSystems/System/Replies.lean +++ b/src/RandomSystems/System/Replies.lean @@ -34,10 +34,10 @@ def Replies (s : System A B) (xs : List A) (ys : List B) : Prop := ys.length = xs.length ∧ ∀ k (hk : k < xs.length) (hk' : k < ys.length), s (xs.take (k + 1)) = Part.some ys[k] -@[simp] theorem replies_nil (s : System A B) : Replies s [] [] := +@[simp] lemma replies_nil (s : System A B) : Replies s [] [] := ⟨rfl, fun k hk => absurd hk (by simp)⟩ -theorem replies_snoc {s : System A B} {xs : List A} {ys : List B} {x : A} {y : B} : +lemma replies_snoc {s : System A B} {xs : List A} {ys : List B} {x : A} {y : B} : Replies s (xs ++ [x]) (ys ++ [y]) ↔ Replies s xs ys ∧ s (xs ++ [x]) = Part.some y := by constructor · rintro ⟨hl, h⟩ @@ -61,7 +61,7 @@ theorem replies_snoc {s : System A B} {xs : List A} {ys : List B} {x : A} {y : B simpa [hl] using hx /-- Systems that agree on the prefixes of `xs` give the same replies to `xs`. -/ -theorem replies_congr_of_prefix {s t : System A B} {xs : List A} +lemma replies_congr_of_prefix {s t : System A B} {xs : List A} (h : ∀ p, p <+: xs → s p = t p) (ys : List B) : Replies s xs ys ↔ Replies t xs ys := by constructor @@ -70,9 +70,9 @@ theorem replies_congr_of_prefix {s t : System A B} {xs : List A} · rintro ⟨hl, hr⟩ exact ⟨hl, fun k hk hk' => (h _ (List.take_prefix _ _)).trans (hr k hk hk')⟩ -theorem Replies.length {s : System A B} {xs ys} (h : Replies s xs ys) : ys.length = xs.length := h.1 +lemma Replies.length {s : System A B} {xs ys} (h : Replies s xs ys) : ys.length = xs.length := h.1 -theorem Replies.dom {s : System A B} {xs ys} (h : Replies s xs ys) (hne : xs ≠ []) : +lemma Replies.dom {s : System A B} {xs ys} (h : Replies s xs ys) (hne : xs ≠ []) : (s xs).Dom := by obtain ⟨xs', x, rfl⟩ := List.eq_nil_or_concat xs |>.resolve_left hne have hyn : ys ≠ [] := by intro he; have hl := h.length; simp [he] at hl @@ -82,7 +82,7 @@ theorem Replies.dom {s : System A B} {xs ys} (h : Replies s xs ys) (hne : xs ≠ trivial /-- A completed transcript contains a reply at every nonempty input prefix. -/ -theorem Replies.reach {s : System A B} {xs ys} (hr : Replies s xs ys) : Reach s xs := by +lemma Replies.reach {s : System A B} {xs ys} (hr : Replies s xs ys) : Reach s xs := by induction xs using List.reverseRecOn generalizing ys with | nil => exact reach_nil s | append_singleton xs x ih => @@ -92,14 +92,14 @@ theorem Replies.reach {s : System A B} {xs ys} (hr : Replies s xs ys) : Reach s exact reach_snoc_iff.mpr ⟨ih hr, by rw [hy]; trivial⟩ /-- Extending a partial function preserves all of its completed replies. -/ -theorem Replies.mono {s t : System A B} (hst : ∀ h y, y ∈ s h → y ∈ t h) +lemma Replies.mono {s t : System A B} (hst : ∀ h y, y ∈ s h → y ∈ t h) {xs ys} (hr : Replies s xs ys) : Replies t xs ys := ⟨hr.length, fun i hi hj => Part.eq_some_iff.mpr (hst _ _ (Part.eq_some_iff.mp (hr.2 i hi hj)))⟩ /-- Two systems with the same domain, the first replying only as the second, have the same transcripts. -/ -theorem replies_iff_of_dom_iff {s t : System A B} (hd : ∀ h, (s h).Dom ↔ (t h).Dom) +lemma replies_iff_of_dom_iff {s t : System A B} (hd : ∀ h, (s h).Dom ↔ (t h).Dom) (hle : ∀ xs ys, Replies s xs ys → Replies t xs ys) (xs : List A) (ys : List B) : Replies s xs ys ↔ Replies t xs ys := by refine ⟨hle xs ys, fun hr => ?_⟩ @@ -118,7 +118,7 @@ theorem replies_iff_of_dom_iff {s t : System A B} (hd : ∀ h, (s h).Dom ↔ (t exact hs /-- Every reachable input history has its uniquely determined list of replies. -/ -theorem Reach.exists_replies {s : System A B} {xs : List A} (hr : Reach s xs) : +lemma Reach.exists_replies {s : System A B} {xs : List A} (hr : Reach s xs) : ∃ ys, Replies s xs ys := by induction xs using List.reverseRecOn with | nil => exact ⟨[], replies_nil s⟩ @@ -129,7 +129,7 @@ theorem Reach.exists_replies {s : System A B} {xs : List A} (hr : Reach s xs) : exact ⟨ys ++ [y], replies_snoc.mpr ⟨hy, Part.eq_some_iff.mpr hy'⟩⟩ /-- Trimming removes no completed transcript. -/ -theorem replies_trim_iff (s : System A B) (xs : List A) (ys : List B) : +lemma replies_trim_iff (s : System A B) (xs : List A) (ys : List B) : Replies (trim s) xs ys ↔ Replies s xs ys := by constructor · rintro ⟨hl, hr⟩ @@ -148,7 +148,7 @@ theorem replies_trim_iff (s : System A B) (xs : List A) (ys : List B) : exact hr.2 i hi hj /-- For DDSs, complete input/output behavior determines the partial function. -/ -theorem IsDDS.eq_of_replies_iff {s t : System A B} (hs : IsDDS s) (ht : IsDDS t) +lemma IsDDS.eq_of_replies_iff {s t : System A B} (hs : IsDDS s) (ht : IsDDS t) (he : ∀ xs ys, Replies s xs ys ↔ Replies t xs ys) : s = t := by have step {s t : System A B} (hs : IsDDS s) (h : ∀ xs ys, Replies s xs ys → Replies t xs ys) (xs : List A) (y : B) @@ -169,13 +169,13 @@ section Transcripts variable {A B : Type} -theorem Transcript.replies {s : System A B} {e xs ys} (tr : Transcript s e xs ys) : +lemma Transcript.replies {s : System A B} {e xs ys} (tr : Transcript s e xs ys) : Replies s xs ys := by induction tr with | nil => exact replies_nil s | snoc tr hx hy ih => exact replies_snoc.mpr ⟨ih, Part.eq_some_iff.mpr hy⟩ -theorem Transcript.of_replies {s t : System A B} {e xs ys} (tr : Transcript s e xs ys) +lemma Transcript.of_replies {s t : System A B} {e xs ys} (tr : Transcript s e xs ys) (h : Replies t xs ys) : Transcript t e xs ys := by induction tr with | nil => exact Transcript.nil @@ -183,7 +183,7 @@ theorem Transcript.of_replies {s t : System A B} {e xs ys} (tr : Transcript s e obtain ⟨h₁, h₂⟩ := replies_snoc.mp h exact Transcript.snoc (ih h₁) hx (Part.eq_some_iff.mp h₂) -theorem transcript_fixedQueries_of_replies {s : System A B} : +lemma transcript_fixedQueries_of_replies {s : System A B} : ∀ {xs ys} (H : List A), xs <+: H → Replies s xs ys → Transcript s (fixedQueries H) xs ys := by intro xs induction xs using List.reverseRecOn with @@ -202,13 +202,13 @@ theorem transcript_fixedQueries_of_replies {s : System A B} : obtain ⟨e, rfl⟩ := hp simp [fixedQueries, h₁.length] -theorem transcript_fixedQueries_iff {s : System A B} {xs ys} : +lemma transcript_fixedQueries_iff {s : System A B} {xs ys} : Transcript s (fixedQueries xs) xs ys ↔ Replies s xs ys := ⟨Transcript.replies, transcript_fixedQueries_of_replies xs (List.prefix_refl xs)⟩ end Transcripts -theorem relabel_mono {A B A' B' : Type} {s t : System A B} +lemma relabel_mono {A B A' B' : Type} {s t : System A B} (hst : ∀ h y, y ∈ s h → y ∈ t h) (f : A' → A) (g : B → B') : ∀ h y, y ∈ relabel s f g h → y ∈ relabel t f g h := by intro h y hy @@ -216,7 +216,7 @@ theorem relabel_mono {A B A' B' : Type} {s t : System A B} exact (Part.mem_map_iff _).mpr ⟨v, hst _ _ hv, he⟩ /-- The transcripts of a relabeled system are the relabeled transcripts. -/ -theorem replies_relabel_iff {A B A' B' : Type} (s : System A B) +lemma replies_relabel_iff {A B A' B' : Type} (s : System A B) (i : A' ≃ A) (o : B ≃ B') (h : List (A' × B')) : Replies (relabel s i o) (h.map Prod.fst) (h.map Prod.snd) ↔ Replies s ((h.map (i.prodCongr o.symm)).map Prod.fst) @@ -234,7 +234,7 @@ theorem replies_relabel_iff {A B A' B' : Type} (s : System A B) rfl /-- A suffix of replies in `P` is counted by the existing consecutive-reply count. -/ -theorem Replies.suffix_le_run {s : System A B} (P : B → Prop) +lemma Replies.suffix_le_run {s : System A B} (P : B → Prop) (h e : List (A × B)) (hr : Replies s ((h ++ e).map Prod.fst) ((h ++ e).map Prod.snd)) (he : ∀ z ∈ e, P z.2) : e.length ≤ run P s ((h ++ e).map Prod.fst) := by @@ -252,7 +252,7 @@ theorem Replies.suffix_le_run {s : System A B} (P : B → Prop) simpa using Nat.succ_le_succ hb /-- The consecutive-reply count is realized by an actual suffix of the transcript. -/ -theorem Replies.exists_suffix_run {s : System A B} (P : B → Prop) +lemma Replies.exists_suffix_run {s : System A B} (P : B → Prop) (h : List (A × B)) (hr : Replies s (h.map Prod.fst) (h.map Prod.snd)) : ∃ p e, h = p ++ e ∧ (∀ z ∈ e, P z.2) ∧ run P s (h.map Prod.fst) = e.length := by induction h using List.reverseRecOn with @@ -275,7 +275,7 @@ theorem Replies.exists_suffix_run {s : System A B} (P : B → Prop) /-- Exact next-query admission on produced histories determines the whole prefix-closed domain after trimming. -/ -theorem trim_dom_of_admission {A B : Type} {s : System A B} {E : List A → Prop} +lemma trim_dom_of_admission {A B : Type} {s : System A B} {E : List A → Prop} (hs₀ : SilentAtEmpty s) (hE : ¬ E [] ∧ ∀ {p h}, p <+: h → p ≠ [] → E h → E p) (hs : ∀ h x ys, Replies s h ys → ((s (h ++ [x])).Dom ↔ E (h ++ [x]))) : diff --git a/src/Tests/AuthenticatedEncryption.lean b/src/Tests/AuthenticatedEncryption.lean index 2189038..6ffca6b 100644 --- a/src/Tests/AuthenticatedEncryption.lean +++ b/src/Tests/AuthenticatedEncryption.lean @@ -26,7 +26,7 @@ noncomputable def oneTimePad : SymmetricEncryption Bool Bool Bool where dec k c := some (xor k c) /-- The collision step on the one-time pad: within `q_e² / 2`. -/ -theorem oneTimePad_hybrid_ideal (q : AE.Port → ℕ) : +lemma oneTimePad_hybrid_ideal (q : AE.Port → ℕ) : Δ (Hybrid oneTimePad q) (AE.Ideal.perPort Bool Bool (budget := q) • Encryption.Real.perPort oneTimePad : Interface.Resource (AE.perPort Bool Bool q)) ≤ ((q .enc) ^ 2 / 2 : ℝ≥0) := by @@ -34,7 +34,7 @@ theorem oneTimePad_hybrid_ideal (q : AE.Port → ℕ) : /-- The collision step on the one-time pad, through the games layer: every solver's advantage is within `q_e² / 2`. -/ -theorem oneTimePad_hybrid_ideal_advantage (q : AE.Port → ℕ) {s} +lemma oneTimePad_hybrid_ideal_advantage (q : AE.Port → ℕ) {s} (hs : s ∈ DistinctionGames.solvers (AE.perPort Bool Bool q)) : |s.1 (Hybrid oneTimePad q) - s.1 (AE.Ideal.perPort Bool Bool (budget := q) • Encryption.Real.perPort oneTimePad : Interface.Resource (AE.perPort Bool Bool q))| ≤ @@ -42,7 +42,7 @@ theorem oneTimePad_hybrid_ideal_advantage (q : AE.Port → ℕ) {s} simpa using GameExamples.hybrid_ideal_advantage_le oneTimePad q hs /-- The corrected chain on the one-time pad uses each assumption twice. -/ -theorem oneTimePad_usage (q : AE.Port → ℕ) : +lemma oneTimePad_usage (q : AE.Port → ℕ) : (correctedChain oneTimePad q).usageCount .cca = 2 ∧ (correctedChain oneTimePad q).usageCount .ptxt = 2 := ⟨correctedChain_cca oneTimePad q, correctedChain_ptxt oneTimePad q⟩ @@ -55,12 +55,12 @@ example (q : AE.Port → ℕ) [AdmissibleDistinguishers] ⟨_, ae_of_ind_cca_int_ptxt oneTimePad q εptxt εcca ptxt cca⟩ /-- Before any encryption, the plaintext filter rejects every decryption. -/ -theorem ptxtDecrypt_initial {Ω : Type} (decrypt : Ω → List Bool → Bool → Option Bool) (ω : Ω) +lemma ptxtDecrypt_initial {Ω : Type} (decrypt : Ω → List Bool → Bool → Option Bool) (ω : Ω) (c : Bool) : ptxtDecrypt decrypt ω [] c = none := by simp [ptxtDecrypt, AE.retain] /-- Before any encryption, the ideal transformation rejects every ciphertext. -/ -theorem idealDecrypt_initial {Ω : Type} {k : ℕ} (encrypt : Ω → ℕ → Bool → Bool) +lemma idealDecrypt_initial {Ω : Type} {k : ℕ} (encrypt : Ω → ℕ → Bool → Bool) (ω : Ω × (Fin k → Bool)) (c : Bool) : idealDecrypt (DSL.uniform Bool) encrypt ω [] c = none := by simp [idealDecrypt, AE.replay] diff --git a/src/Tests/Counterexamples.lean b/src/Tests/Counterexamples.lean index a1ba812..dc998cd 100644 --- a/src/Tests/Counterexamples.lean +++ b/src/Tests/Counterexamples.lean @@ -25,7 +25,7 @@ def echo : System Unit Unit := fun h => if h = [] then Part.none else Part.some def spinRoute : Unit → Empty ⊕ Unit := fun _ => .inr () /-- Once `spinner` has received an input, the exchange of the composite never stops. -/ -theorem spinner_no_exchange {H : List (Σ o, optF Unit (fun _ : Unit => Unit) o)} {o H'} +lemma spinner_no_exchange {H : List (Σ o, optF Unit (fun _ : Unit => Unit) o)} {o H'} (l : Exchange (parAll (optS spinner fun _ : Unit => echo)) (routeOpt (B := fun _ : Unit => Unit) spinRoute) H o H') : ∀ H₁ (x : Unit), H = H₁ ++ [⟨none, x⟩] → False := by @@ -48,7 +48,7 @@ theorem spinner_no_exchange {H : List (Σ o, optF Unit (fun _ : Unit => Unit) o) exact ih _ _ (by rw [← hr]) /-- **Locality fails for a non-terminating component.** -/ -theorem locality_fails_without_termination : +lemma locality_fails_without_termination : parAll (optS (interconnect spinner spinRoute id) fun _ : Unit => echo) ≠ interconnect (parAll (optS spinner fun _ : Unit => echo)) (routeOpt (B := fun _ : Unit => Unit) spinRoute) (injOpt (A := fun _ : Unit => Unit) id) := by @@ -84,7 +84,7 @@ def talker : InterfaceSystem Unit (fun _ => Unit) (fun _ => Unit) := fun h => /-- **The identity law fails for a system that speaks first**: connection never consults the empty history. -/ -theorem identity_fails_without_reactivity : +lemma identity_fails_without_reactivity : relabel (attachAlong (id : Unit → Unit) (forwardAll Unit (fun _ => Unit) (fun _ => Unit)) talker) (idAlongIn (Y := Unit) id) (idAlongOut id) ≠ talker := by intro e diff --git a/src/Tests/DSL/Semantics.lean b/src/Tests/DSL/Semantics.lean index 7f1d7e7..78c3fea 100644 --- a/src/Tests/DSL/Semantics.lean +++ b/src/Tests/DSL/Semantics.lean @@ -20,13 +20,13 @@ namespace DSLTests.Semantics open DSLExamples /-- One call samples the source's next entry and returns it. -/ -theorem freshBits_invoke {K : ℕ} (t : Fin K → Bool) (st : Option Unit) (k : ℕ) : +lemma freshBits_invoke {K : ℕ} (t : Fin K → Bool) (st : Option Unit) (k : ℕ) : FreshBits.body.invoke (sourceStep FreshBits.law1) st .bit () 1 (t, k) [] = some ((some (), (t, k + 1)), if hk : k < K then t ⟨k, hk⟩ else Classical.choice FreshBits.law1.nonempty) := by cases st <;> simp [Program.invoke, FreshBits.body, callProg, returnProg, sourceStep] -theorem freshBits_stateAfter {K : ℕ} (t : Fin K → Bool) (bs : List Bool) : +lemma freshBits_stateAfter {K : ℕ} (t : Fin K → Bool) (bs : List Bool) : stateAfter (FreshBits.body.combine (sourceStep FreshBits.law1) FreshBits.bound_spec) (none, (t, 0)) (bs.map fun _ => ⟨.bit, ()⟩) = (if bs = [] then none else some (), (t, bs.length)) := by @@ -37,7 +37,7 @@ theorem freshBits_stateAfter {K : ℕ} (t : Fin K → Bool) (bs : List Bool) : rw [Program.combine_eq_of_invoke _ _ (freshBits_invoke t _ bs.length)] simp -theorem freshBits_replies {K : ℕ} (t : Fin K → Bool) (bs : List Bool) (hn : bs.length ≤ K) : +lemma freshBits_replies {K : ℕ} (t : Fin K → Bool) (bs : List Bool) (hn : bs.length ≤ K) : Replies (automatonSystem (FreshBits.body.combine (sourceStep FreshBits.law1) FreshBits.bound_spec) (none, (t, 0))) (bs.map fun _ => ⟨.bit, ()⟩) (bs.map fun b => ⟨.bit, b⟩) ↔ @@ -63,7 +63,7 @@ theorem freshBits_replies {K : ℕ} (t : Fin K → Bool) (bs : List Bool) (hn : have hk' := h k (by simp; omega) rwa [List.getElem_append_left hk] at hk' -theorem mass_prefix {K : ℕ} (bs : List Bool) (hn : bs.length ≤ K) : +lemma mass_prefix {K : ℕ} (bs : List Bool) (hn : bs.length ≤ K) : (Distribution.pi fun _ : Fin K => (𝒰[Bool]).1).mass (fun tbl => ∀ k (hk : k < bs.length), tbl ⟨k, by omega⟩ = bs[k]) = (1 / 2) ^ bs.length := by @@ -98,7 +98,7 @@ theorem mass_prefix {K : ℕ} (bs : List Bool) (hn : bs.length ≤ K) : rw [Function.update_of_ne (by simp [Fin.ext_iff]; omega)] /-- Fresh sampling is independent for every number of calls within the budget. -/ -theorem freshBits_independent {q : ℕ} (bs : List Bool) (hq : bs.length ≤ q) : +lemma freshBits_independent {q : ℕ} (bs : List Bool) (hq : bs.length ≤ q) : (FreshBits (budget := q)).1 (bs.map fun b => (⟨.bit, ()⟩, ⟨.bit, b⟩)) = (1 / 2) ^ bs.length := by have hb : 1 ≤ FreshBits.bound := FreshBits.bound_spec none .bit () [] ⟨(), ()⟩ @@ -114,20 +114,20 @@ theorem freshBits_independent {q : ℕ} (bs : List Bool) (hq : bs.length ≤ q) exact freshBits_replies t bs hK /-- The first call samples the secret; later calls return it without sampling. -/ -theorem secretBit_combine_first {K : ℕ} (t : Fin K → Bool) : +lemma secretBit_combine_first {K : ℕ} (t : Fin K → Bool) : SecretBit.body.combine (sourceStep SecretBit.law1) SecretBit.bound_spec (none, (t, 0)) .bit () = ((some (if h : 0 < K then t ⟨0, h⟩ else Classical.choice SecretBit.law1.nonempty), (t, 1)), if h : 0 < K then t ⟨0, h⟩ else Classical.choice SecretBit.law1.nonempty) := Program.combine_eq_of_invoke _ _ (n := 1) (by simp [Program.invoke, SecretBit.body, callProg, returnProg, sourceStep]) -theorem secretBit_combine_later {K : ℕ} (v : Bool) (r : (Fin K → Bool) × ℕ) : +lemma secretBit_combine_later {K : ℕ} (v : Bool) (r : (Fin K → Bool) × ℕ) : SecretBit.body.combine (sourceStep SecretBit.law1) SecretBit.bound_spec (some v, r) .bit () = ((some v, r), v) := Program.combine_eq_of_invoke _ _ (n := 0) (by simp [Program.invoke, SecretBit.body, returnProg]) /-- Sampling at initialization retains the same bit on later calls, at every budget. -/ -theorem secretBit_retained (q : ℕ) (b : Bool) : +lemma secretBit_retained (q : ℕ) (b : Bool) : (SecretBit (budget := q)).1 [(⟨.bit, ()⟩, ⟨.bit, b⟩), (⟨.bit, ()⟩, ⟨.bit, !b⟩)] = 0 := by rw [SecretBit, SecretBit.randomness, SecretBit.program, Resource.source, Converter.ofProgram_smul_ofAutomaton, Resource.ofAutomaton_mass, @@ -146,7 +146,7 @@ theorem secretBit_retained (q : ℕ) (b : Bool) : cases b <;> simp_all /-- The two ports share the counter. -/ -theorem counter_interleaving {q : ℕ} (hq : 3 ≤ q) : +lemma counter_interleaving {q : ℕ} (hq : 3 ≤ q) : (Counter (budget := q)).1 [(⟨.next, ()⟩, ⟨.next, 1⟩), (⟨.read, ()⟩, ⟨.read, 1⟩), (⟨.next, ()⟩, ⟨.next, 2⟩)] = 1 := by rw [Counter, Interface.Resource.ofAutomaton_mass] @@ -162,7 +162,7 @@ def counterBudget : Counter.Port → ℕ | .read => 1 /-- At per-port budgets, the two ports share the counter within their own budgets. -/ -theorem counter_perPort_interleaving : +lemma counter_perPort_interleaving : (Counter.perPort (budget := counterBudget)).1 [(⟨.next, ()⟩, ⟨.next, 1⟩), (⟨.read, ()⟩, ⟨.read, 1⟩), (⟨.next, ()⟩, ⟨.next, 2⟩)] = 1 := by rw [Counter.perPort, Interface.Resource.ofAutomaton_mass] @@ -174,7 +174,7 @@ theorem counter_perPort_interleaving : automatonSystem_snoc] <;> rfl /-- A second query at `read` exceeds its budget. -/ -theorem counter_perPort_exceeded (n m : Fin 16) : +lemma counter_perPort_exceeded (n m : Fin 16) : (Counter.perPort (budget := counterBudget)).1 [(⟨.read, ()⟩, ⟨.read, n⟩), (⟨.read, ()⟩, ⟨.read, m⟩)] = 0 := by rw [Counter.perPort, Interface.Resource.ofAutomaton_mass] diff --git a/src/Tests/Substitution/Calculation.lean b/src/Tests/Substitution/Calculation.lean index 1a9f5ee..d7e2fcd 100644 --- a/src/Tests/Substitution/Calculation.lean +++ b/src/Tests/Substitution/Calculation.lean @@ -38,7 +38,7 @@ local infix:50 " ≃ₛ " => relation.substitutes _ /-- Banfi, Section 2.3.1 (printed p. 15): "we explicitly show the implication by the following sequence of steps". The calculation keeps each supplied transformation, orientation, and exact join visible. -/ -theorem substitutes_of_two_steps +lemma substitutes_of_two_steps (R₀ R₁ S₀ S₁ : Phi B) (X Y : Phi A) (α β : A ⟶ B) (hR : R₀ ≃ₛ R₁) (hS : S₀ ≃ₛ S₁) @@ -56,7 +56,7 @@ local notation "d" => distance /-- Banfi, Section 2.3.1 (printed p. 15): "we then collect the sum of such pᵢ's into a value ε". This companion uses separately supplied statistical bounds; it does not infer them from the substitution premises. -/ -theorem distance_two_steps_le [MonoidalCategory C] [CompatiblePseudoMetric C Phi] +lemma distance_two_steps_le [MonoidalCategory C] [CompatiblePseudoMetric C Phi] (R₀ R₁ S₀ S₁ : Phi B) (X Y : Phi A) (α β : A ⟶ B) (ε₁ ε₂ : ENNReal) (hR : d R₀ R₁ ≤ ε₁) (hS : d S₀ S₁ ≤ ε₂) diff --git a/src/Tests/Substitution/Construction.lean b/src/Tests/Substitution/Construction.lean index a74b492..cfae942 100644 --- a/src/Tests/Substitution/Construction.lean +++ b/src/Tests/Substitution/Construction.lean @@ -26,7 +26,7 @@ variable {outerSystems : ∀ i, Bool → Phi (outerBoundary i)} -- Two uses of one premise in the first proof and one use in a distinct -- source family stay 2 and 1 after serial composition. The families may be -- infinite and their individual assumptions may have heterogeneous interfaces. -theorem repeated_assumption_counts [DecidableEq ι] [DecidableEq κ] {A : C} +lemma repeated_assumption_counts [DecidableEq ι] [DecidableEq κ] {A : C} (innerAssumption : ι) (outerAssumption : κ) (innerTransformation : A ⟶ innerBoundary innerAssumption) (outerTransformation : A ⟶ outerBoundary outerAssumption) @@ -67,7 +67,7 @@ theorem repeated_assumption_counts [DecidableEq ι] [DecidableEq κ] {A : C} -- Banfi's existential simulator statement, with honest/adversarial locality -- proved by ordered tensor. Resources are arbitrary joint resources: none -- is assumed to factor into an honest and an adversarial component. -theorem construction_serial_disjoint [MonoidalCategory C] +lemma construction_serial_disjoint [MonoidalCategory C] {A B D E : C} (innerProtocol : B ⟶ D) (outerProtocol : A ⟶ B) (real : Phi (D ⊗ E)) (middle : Phi (B ⊗ E)) (ideal : Phi (A ⊗ E)) diff --git a/src/Tests/Substitution/Implication.lean b/src/Tests/Substitution/Implication.lean index a7841a7..3ac8085 100644 --- a/src/Tests/Substitution/Implication.lean +++ b/src/Tests/Substitution/Implication.lean @@ -35,7 +35,7 @@ example (assumption : ι) : -- Heterogeneous assumptions, a reversed second use, and an additional outer -- context exercise the actual dependent chain rather than a same-fibre shortcut. -theorem transformed_chain_counts [DecidableEq ι] {A B : C} +lemma transformed_chain_counts [DecidableEq ι] {A B : C} (firstAssumption secondAssumption : ι) (firstTransform : B ⟶ boundary firstAssumption) (secondTransform : B ⟶ boundary secondAssumption) @@ -108,7 +108,7 @@ example (relation : SubstitutionRelation C) -- An explicit implication now enters the existing CC specification calculus. -- The diagonal hypothesis remains visible, as required by Jost's relaxation. -theorem construction_of_implication {A B : C} {uses : Nat} +lemma construction_of_implication {A B : C} {uses : Nat} (protocol : A ⟶ B) (simulator : A ⟶ A) (real : Phi B) (ideal : Phi A) (implication : Implication boundary systems A uses) diff --git a/src/Tests/Substitution/Quantitative.lean b/src/Tests/Substitution/Quantitative.lean index ab91985..ef85f1f 100644 --- a/src/Tests/Substitution/Quantitative.lean +++ b/src/Tests/Substitution/Quantitative.lean @@ -23,7 +23,7 @@ variable {Distinguisher : C → Type y} -- A three-step source chain uses the named assumption twice and a statistical -- bound once. The middle reverse step is not counted as an assumption use. -theorem mixed_three_steps [MonoidalCategory C] [CompatiblePseudoMetric C Phi] {A : C} +lemma mixed_three_steps [MonoidalCategory C] [CompatiblePseudoMetric C Phi] {A : C} (model : DistinguisherAdvantage C Phi Distinguisher) (left right : Phi A) (loss : Distinguisher A → ENNReal) (error : ENNReal) (domination : ∀ distinguisher ∈ model.admissible A, diff --git a/src/Tests/Substitution/Relaxation.lean b/src/Tests/Substitution/Relaxation.lean index ffa49cd..dfe6809 100644 --- a/src/Tests/Substitution/Relaxation.lean +++ b/src/Tests/Substitution/Relaxation.lean @@ -22,7 +22,7 @@ variable {Phi : C → Type w} [ResourceTheory C Phi] -- The literal one-use statement works with a supplied transformation and two -- exact endpoints, without an unrelated substitution relation or reflexivity axiom. -theorem construction_of_single_substitution {A B D E : C} +lemma construction_of_single_substitution {A B D E : C} (transformations : Set (A ⟶ B)) (left right : Phi B) (protocol : A ⟶ D) (simulator : A ⟶ E) (real : Phi D) (ideal : Phi E) @@ -45,7 +45,7 @@ example {A B : C} (left right : Phi B) (resource : Phi A) : -- A literal one-use image embeds in the finite-chain presentation with -- exactly one forward use of the sole assumption. The converse is not assumed. -theorem single_image_has_one_use {A B : C} +lemma single_image_has_one_use {A B : C} (transformations : Set (A ⟶ B)) (left right : Phi B) (source : Specification (Phi A)) (resource : Phi A) diff --git a/src/Tests/Substitution/Tactics.lean b/src/Tests/Substitution/Tactics.lean index a786dba..1bd2c98 100644 --- a/src/Tests/Substitution/Tactics.lean +++ b/src/Tests/Substitution/Tactics.lean @@ -34,7 +34,7 @@ noncomputable def countedChain (i j : ι) _ ≃ β • systems j false := ← j _ = Y := finish -theorem countedChain_usageCount [DecidableEq ι] (i j k : ι) +lemma countedChain_usageCount [DecidableEq ι] (i j k : ι) (α : A ⟶ boundary i) (β : A ⟶ boundary j) (X Y : Phi A) (start : X = α • systems i false) (join : α • systems i true = β • systems j true) @@ -165,7 +165,7 @@ section Quantitative variable [MonoidalCategory C] [CompatiblePseudoMetric C Phi] {D : C → Type y} -- Distances are scalar, may be supplied before attachment, and can be reversed. -theorem statistical_chain (α : A ⟶ B) (R S T : Phi B) +lemma statistical_chain (α : A ⟶ B) (R S T : Phi B) (X Y : Phi A) (a b : ENNReal) (h : distance R S ≤ a) (g : distance T S ≤ b) (start : X = α • R) (finish : α • T = Y) : distance X Y ≤ a + b := by @@ -176,7 +176,7 @@ theorem statistical_chain (α : A ⟶ B) (R S T : Phi B) _ = Y := finish -- Statistical steps do not become assumptions, and concrete losses retain D. -theorem mixed_chain (model : DistinguisherAdvantage C Phi D) +lemma mixed_chain (model : DistinguisherAdvantage C Phi D) (R S T U X Y : Phi A) (a b : D A → ENNReal) (ε : ENNReal) (domination : ∀ d ∈ model.admissible A, ∀ r s, model.advantage A d r s ≤ distance r s) @@ -284,7 +284,7 @@ variable (domination : ∀ D ∈ model.admissible (), ∀ R T, model.advantage () D R T ≤ statistical D R T) include domination -theorem observation_chain (R S T : Sys) (loss : O → ENNReal) (ε : ENNReal) +lemma observation_chain (R S T : Sys) (loss : O → ENNReal) (ε : ENNReal) (h : model.SubstitutesWithin (A := ()) loss R S) (g : ∀ D ∈ model.admissible (), statistical D T S ≤ ε) : model.SubstitutesWithin (A := ()) (fun D => loss D + ε) R T := by