feat(library/standard): add notation for symm, trans and subst
Signed-off-by: Leonardo de Moura <leonardo@microsoft.com>
This commit is contained in:
Leonardo de Moura
parent
ebf34f2fe9
commit
62483b793f
7 changed files with 81 additions and 69 deletions
|
|
@ -2,6 +2,7 @@
|
|||
-- Released under Apache 2.0 license as described in the file LICENSE.
|
||||
-- Author: Leonardo de Moura
|
||||
import logic
|
||||
using eq_proofs
|
||||
|
||||
namespace binary
|
||||
section
|
||||
|
|
@ -22,7 +23,7 @@ section
|
|||
|
||||
theorem left_comm : ∀a b c, a*(b*c) = b*(a*c)
|
||||
:= take a b c, calc
|
||||
a*(b*c) = (a*b)*c : symm (H_assoc _ _ _)
|
||||
a*(b*c) = (a*b)*c : (H_assoc _ _ _)⁻¹
|
||||
... = (b*a)*c : {H_comm _ _}
|
||||
... = b*(a*c) : H_assoc _ _ _
|
||||
|
||||
|
|
@ -30,6 +31,6 @@ section
|
|||
:= take a b c, calc
|
||||
(a*b)*c = a*(b*c) : H_assoc _ _ _
|
||||
... = a*(c*b) : {H_comm _ _}
|
||||
... = (a*c)*b : symm (H_assoc _ _ _)
|
||||
... = (a*c)*b : (H_assoc _ _ _)⁻¹
|
||||
end
|
||||
end
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
-- Released under Apache 2.0 license as described in the file LICENSE.
|
||||
-- Author: Leonardo de Moura
|
||||
import logic decidable
|
||||
using eq_proofs
|
||||
|
||||
namespace bool
|
||||
inductive bool : Type :=
|
||||
|
|
@ -30,8 +31,8 @@ theorem cond_b1 {A : Type} (t e : A) : cond '1 t e = t
|
|||
|
||||
theorem b0_ne_b1 : ¬ '0 = '1
|
||||
:= assume H : '0 = '1, absurd
|
||||
(calc true = cond '1 true false : symm (cond_b1 _ _)
|
||||
... = cond '0 true false : {symm H}
|
||||
(calc true = cond '1 true false : (cond_b1 _ _)⁻¹
|
||||
... = cond '0 true false : {H⁻¹}
|
||||
... = false : cond_b0 _ _)
|
||||
true_ne_false
|
||||
|
||||
|
|
@ -89,8 +90,8 @@ theorem band_eq_b1_elim_left {a b : bool} (H : a && b = '1) : a = '1
|
|||
:= or_elim (dichotomy a)
|
||||
(assume H0 : a = '0,
|
||||
absurd_elim (a = '1)
|
||||
(calc '0 = '0 && b : symm (band_b0_left _)
|
||||
... = a && b : {symm H0}
|
||||
(calc '0 = '0 && b : (band_b0_left _)⁻¹
|
||||
... = a && b : {H0⁻¹}
|
||||
... = '1 : H)
|
||||
b0_ne_b1)
|
||||
(assume H1 : a = '1, H1)
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
-- Released under Apache 2.0 license as described in the file LICENSE.
|
||||
-- Author: Leonardo de Moura
|
||||
import logic
|
||||
using eq_proofs
|
||||
|
||||
definition cast {A B : Type} (H : A = B) (a : A) : B
|
||||
:= eq_rec a H
|
||||
|
|
@ -27,11 +28,11 @@ theorem heq_type_eq {A B : Type} {a : A} {b : B} (H : a == b) : A = B
|
|||
:= obtain w Hw, from H, w
|
||||
|
||||
theorem eq_to_heq {A : Type} {a b : A} (H : a = b) : a == b
|
||||
:= exists_intro (refl A) (trans (cast_refl a) H)
|
||||
:= exists_intro (refl A) (cast_refl a ⬝ H)
|
||||
|
||||
theorem heq_to_eq {A : Type} {a b : A} (H : a == b) : a = b
|
||||
:= obtain (w : A = A) (Hw : cast w a = b), from H,
|
||||
calc a = cast w a : symm (cast_eq w a)
|
||||
calc a = cast w a : (cast_eq w a)⁻¹
|
||||
... = b : Hw
|
||||
|
||||
theorem hrefl {A : Type} (a : A) : a == a
|
||||
|
|
@ -44,10 +45,10 @@ opaque_hint (hiding cast)
|
|||
|
||||
theorem hsubst {A B : Type} {a : A} {b : B} {P : ∀ (T : Type), T → Prop} (H1 : a == b) (H2 : P A a) : P B b
|
||||
:= have Haux1 : ∀ H : A = A, P A (cast H a), from
|
||||
assume H : A = A, subst (symm (cast_eq H a)) H2,
|
||||
assume H : A = A, (cast_eq H a)⁻¹ ▸ H2,
|
||||
obtain (Heq : A = B) (Hw : cast Heq a = b), from H1,
|
||||
have Haux2 : P B (cast Heq a), from subst Heq Haux1 Heq,
|
||||
subst Hw Haux2
|
||||
Hw ▸ Haux2
|
||||
|
||||
theorem hsymm {A B : Type} {a : A} {b : B} (H : a == b) : b == a
|
||||
:= hsubst H (hrefl a)
|
||||
|
|
@ -77,10 +78,10 @@ theorem cast_eq_to_heq {A B : Type} {a : A} {b : B} {H : A = B} (H1 : cast H a =
|
|||
:= calc a == cast H a : hsymm (cast_heq H a)
|
||||
... = b : H1
|
||||
|
||||
theorem cast_trans {A B C : Type} (Hab : A = B) (Hbc : B = C) (a : A) : cast Hbc (cast Hab a) = cast (trans Hab Hbc) a
|
||||
theorem cast_trans {A B C : Type} (Hab : A = B) (Hbc : B = C) (a : A) : cast Hbc (cast Hab a) = cast (Hab ⬝ Hbc) a
|
||||
:= heq_to_eq (calc cast Hbc (cast Hab a) == cast Hab a : cast_heq Hbc (cast Hab a)
|
||||
... == a : cast_heq Hab a
|
||||
... == cast (trans Hab Hbc) a : hsymm (cast_heq (trans Hab Hbc) a))
|
||||
... == cast (Hab ⬝ Hbc) a : hsymm (cast_heq (Hab ⬝ Hbc) a))
|
||||
|
||||
theorem dcongr2 {A : Type} {B : A → Type} (f : Πx, B x) {a b : A} (H : a = b) : f a == f b
|
||||
:= have e1 : ∀ (H : B a = B a), cast H (f a) = f a, from
|
||||
|
|
|
|||
|
|
@ -2,13 +2,14 @@
|
|||
-- Released under Apache 2.0 license as described in the file LICENSE.
|
||||
-- Author: Leonardo de Moura
|
||||
import logic cast
|
||||
using eq_proofs
|
||||
|
||||
axiom prop_complete (a : Prop) : a = true ∨ a = false
|
||||
|
||||
theorem case (P : Prop → Prop) (H1 : P true) (H2 : P false) (a : Prop) : P a
|
||||
:= or_elim (prop_complete a)
|
||||
(assume Ht : a = true, subst (symm Ht) H1)
|
||||
(assume Hf : a = false, subst (symm Hf) H2)
|
||||
(assume Ht : a = true, Ht⁻¹ ▸ H1)
|
||||
(assume Hf : a = false, Hf⁻¹ ▸ H2)
|
||||
|
||||
theorem em (a : Prop) : a ∨ ¬a
|
||||
:= or_elim (prop_complete a)
|
||||
|
|
@ -24,20 +25,20 @@ theorem prop_complete_swapped (a : Prop) : a = false ∨ a = true
|
|||
theorem not_true : (¬true) = false
|
||||
:= have aux : ¬ (¬true) = true, from
|
||||
assume H : (¬true) = true,
|
||||
absurd_not_true (subst (symm H) trivial),
|
||||
absurd_not_true (H⁻¹ ▸ trivial),
|
||||
resolve_right (prop_complete (¬true)) aux
|
||||
|
||||
theorem not_false : (¬false) = true
|
||||
:= have aux : ¬ (¬false) = false, from
|
||||
assume H : (¬false) = false,
|
||||
subst H not_false_trivial,
|
||||
H ▸ not_false_trivial,
|
||||
resolve_right (prop_complete_swapped (¬ false)) aux
|
||||
|
||||
theorem not_not_eq (a : Prop) : (¬¬a) = a
|
||||
:= case (λ x, (¬¬x) = x)
|
||||
(calc (¬¬true) = (¬false) : { not_true }
|
||||
(calc (¬¬true) = (¬false) : {not_true}
|
||||
... = true : not_false)
|
||||
(calc (¬¬false) = (¬true) : { not_false }
|
||||
(calc (¬¬false) = (¬true) : {not_false}
|
||||
... = false : not_true)
|
||||
a
|
||||
|
||||
|
|
@ -47,11 +48,11 @@ theorem not_not_elim {a : Prop} (H : ¬¬a) : a
|
|||
theorem propext {a b : Prop} (Hab : a → b) (Hba : b → a) : a = b
|
||||
:= or_elim (prop_complete a)
|
||||
(assume Hat, or_elim (prop_complete b)
|
||||
(assume Hbt, trans Hat (symm Hbt))
|
||||
(assume Hbf, false_elim (a = b) (subst Hbf (Hab (eqt_elim Hat)))))
|
||||
(assume Hbt, Hat ⬝ Hbt⁻¹)
|
||||
(assume Hbf, false_elim (a = b) (Hbf ▸ (Hab (eqt_elim Hat)))))
|
||||
(assume Haf, or_elim (prop_complete b)
|
||||
(assume Hbt, false_elim (a = b) (subst Haf (Hba (eqt_elim Hbt))))
|
||||
(assume Hbf, trans Haf (symm Hbf)))
|
||||
(assume Hbt, false_elim (a = b) (Haf ▸ (Hba (eqt_elim Hbt))))
|
||||
(assume Hbf, Haf ⬝ Hbf⁻¹))
|
||||
|
||||
theorem iff_to_eq {a b : Prop} (H : a ↔ b) : a = b
|
||||
:= iff_elim (assume H1 H2, propext H1 H2) H
|
||||
|
|
@ -112,7 +113,7 @@ theorem imp_or (a b : Prop) : (a → b) = (¬ a ∨ b)
|
|||
(assume Ha : a, or_intro_right (¬ a) (H Ha))
|
||||
(assume Hna : ¬ a, or_intro_left b Hna)))
|
||||
(assume (H : ¬ a ∨ b) (Ha : a),
|
||||
resolve_right H ((symm (not_not_eq a)) ◂ Ha))
|
||||
resolve_right H ((not_not_eq a)⁻¹ ◂ Ha))
|
||||
|
||||
theorem not_implies (a b : Prop) : (¬ (a → b)) = (a ∧ ¬b)
|
||||
:= calc (¬ (a → b)) = (¬(¬a ∨ b)) : {imp_or a b}
|
||||
|
|
@ -122,15 +123,15 @@ theorem not_implies (a b : Prop) : (¬ (a → b)) = (a ∧ ¬b)
|
|||
theorem a_eq_not_a (a : Prop) : (a = ¬a) = false
|
||||
:= propext
|
||||
(assume H, or_elim (em a)
|
||||
(assume Ha, absurd Ha (subst H Ha))
|
||||
(assume Hna, absurd (subst (symm H) Hna) Hna))
|
||||
(assume Ha, absurd Ha (H ▸ Ha))
|
||||
(assume Hna, absurd (H⁻¹ ▸ Hna) Hna))
|
||||
(assume H, false_elim (a = ¬ a) H)
|
||||
|
||||
theorem true_eq_false : (true = false) = false
|
||||
:= subst not_true (a_eq_not_a true)
|
||||
:= not_true ▸ (a_eq_not_a true)
|
||||
|
||||
theorem false_eq_true : (false = true) = false
|
||||
:= subst not_false (a_eq_not_a false)
|
||||
:= not_false ▸ (a_eq_not_a false)
|
||||
|
||||
theorem a_eq_true (a : Prop) : (a = true) = a
|
||||
:= propext (assume H, eqt_elim H) (assume H, eqt_intro H)
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
-- Released under Apache 2.0 license as described in the file LICENSE.
|
||||
-- Authors: Leonardo de Moura, Jeremy Avigad
|
||||
import logic hilbert funext
|
||||
using eq_proofs
|
||||
|
||||
-- Diaconescu’s theorem
|
||||
-- Show that Excluded middle follows from
|
||||
|
|
@ -25,7 +26,7 @@ lemma uv_implies_p [private] : ¬(u = v) ∨ p
|
|||
:= or_elim u_def
|
||||
(assume Hut : u = true, or_elim v_def
|
||||
(assume Hvf : v = false,
|
||||
have Hne : ¬(u = v), from subst (symm Hvf) (subst (symm Hut) true_ne_false),
|
||||
have Hne : ¬(u = v), from Hvf⁻¹ ▸ Hut⁻¹ ▸ true_ne_false,
|
||||
or_intro_left p Hne)
|
||||
(assume Hp : p, or_intro_right (¬u = v) Hp))
|
||||
(assume Hp : p, or_intro_right (¬u = v) Hp)
|
||||
|
|
@ -41,7 +42,7 @@ lemma p_implies_uv [private] : p → u = v
|
|||
show (x = true ∨ p) = (x = false ∨ p), from
|
||||
propext Hl Hr),
|
||||
show u = v, from
|
||||
subst Hpred (refl (epsilon (λ x, x = true ∨ p)))
|
||||
Hpred ▸ (refl (epsilon (λ x, x = true ∨ p)))
|
||||
|
||||
theorem em : p ∨ ¬ p
|
||||
:= have H : ¬(u = v) → ¬ p, from contrapos p_implies_uv,
|
||||
|
|
|
|||
|
|
@ -136,14 +136,21 @@ theorem true_ne_false : ¬true = false
|
|||
theorem symm {A : Type} {a b : A} (H : a = b) : b = a
|
||||
:= subst H (refl a)
|
||||
|
||||
namespace eq_proofs
|
||||
postfix `⁻¹`:100 := symm
|
||||
infixr `⬝`:75 := trans
|
||||
infixr `▸`:75 := subst
|
||||
end
|
||||
using eq_proofs
|
||||
|
||||
theorem congr1 {A : Type} {B : A → Type} {f g : Π x, B x} (H : f = g) (a : A) : f a = g a
|
||||
:= subst H (refl (f a))
|
||||
:= H ▸ (refl (f a))
|
||||
|
||||
theorem congr2 {A : Type} {B : Type} {a b : A} (f : A → B) (H : a = b) : f a = f b
|
||||
:= subst H (refl (f a))
|
||||
:= H ▸ (refl (f a))
|
||||
|
||||
theorem congr {A : Type} {B : Type} {f g : A → B} {a b : A} (H1 : f = g) (H2 : a = b) : f a = g b
|
||||
:= subst H1 (subst H2 (refl (f a)))
|
||||
:= H1 ▸ H2 ▸ (refl (f a))
|
||||
|
||||
theorem equal_f {A : Type} {B : A → Type} {f g : Π x, B x} (H : f = g) : ∀x, f x = g x
|
||||
:= take x, congr1 H x
|
||||
|
|
@ -152,16 +159,16 @@ theorem not_congr {a b : Prop} (H : a = b) : (¬a) = (¬b)
|
|||
:= congr2 not H
|
||||
|
||||
theorem eqmp {a b : Prop} (H1 : a = b) (H2 : a) : b
|
||||
:= subst H1 H2
|
||||
:= H1 ▸ H2
|
||||
|
||||
infixl `<|`:100 := eqmp
|
||||
infixl `◂`:100 := eqmp
|
||||
|
||||
theorem eqmpr {a b : Prop} (H1 : a = b) (H2 : b) : a
|
||||
:= (symm H1) ◂ H2
|
||||
:= H1⁻¹ ◂ H2
|
||||
|
||||
theorem eqt_elim {a : Prop} (H : a = true) : a
|
||||
:= (symm H) ◂ trivial
|
||||
:= H⁻¹ ◂ trivial
|
||||
|
||||
theorem eqf_elim {a : Prop} (H : a = false) : ¬a
|
||||
:= assume Ha : a, H ◂ Ha
|
||||
|
|
@ -191,16 +198,16 @@ theorem ne_irrefl {A : Type} {a : A} (H : a ≠ a) : false
|
|||
:= H (refl a)
|
||||
|
||||
theorem not_eq_symm {A : Type} {a b : A} (H : ¬ a = b) : ¬ b = a
|
||||
:= assume H1 : b = a, H (symm H1)
|
||||
:= assume H1 : b = a, H (H1⁻¹)
|
||||
|
||||
theorem ne_symm {A : Type} {a b : A} (H : a ≠ b) : b ≠ a
|
||||
:= not_eq_symm H
|
||||
|
||||
theorem eq_ne_trans {A : Type} {a b c : A} (H1 : a = b) (H2 : b ≠ c) : a ≠ c
|
||||
:= subst (symm H1) H2
|
||||
:= H1⁻¹ ▸ H2
|
||||
|
||||
theorem ne_eq_trans {A : Type} {a b c : A} (H1 : a ≠ b) (H2 : b = c) : a ≠ c
|
||||
:= subst H2 H1
|
||||
:= H2 ▸ H1
|
||||
|
||||
calc_trans eq_ne_trans
|
||||
calc_trans ne_eq_trans
|
||||
|
|
@ -247,7 +254,7 @@ theorem iff_symm {a b : Prop} (H : a ↔ b) : b ↔ a
|
|||
calc_trans iff_trans
|
||||
|
||||
theorem eq_to_iff {a b : Prop} (H : a = b) : a ↔ b
|
||||
:= iff_intro (λ Ha, subst H Ha) (λ Hb, subst (symm H) Hb)
|
||||
:= iff_intro (λ Ha, H ▸ Ha) (λ Hb, H⁻¹ ▸ Hb)
|
||||
|
||||
theorem and_comm (a b : Prop) : a ∧ b ↔ b ∧ a
|
||||
:= iff_intro (λH, and_swap H) (λH, and_swap H)
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
-- Author: Floris van Doorn
|
||||
----------------------------------------------------------------------------------------------------
|
||||
import logic num tactic decidable binary
|
||||
using tactic num binary
|
||||
using tactic num binary eq_proofs
|
||||
using decidable (hiding induction_on rec_on)
|
||||
|
||||
namespace nat
|
||||
|
|
@ -57,7 +57,7 @@ theorem zero_or_succ (n : ℕ) : n = 0 ∨ n = succ (pred n)
|
|||
:= induction_on n
|
||||
(or_intro_left _ (refl 0))
|
||||
(take m IH, or_intro_right _
|
||||
(show succ m = succ (pred (succ m)), from congr2 succ (symm (pred_succ m))))
|
||||
(show succ m = succ (pred (succ m)), from congr2 succ (pred_succ m⁻¹)))
|
||||
|
||||
theorem zero_or_succ2 (n : ℕ) : n = 0 ∨ ∃k, n = succ k
|
||||
:= or_imp_or (zero_or_succ n) (assume H, H) (assume H : n = succ (pred n), exists_intro (pred n) H)
|
||||
|
|
@ -72,7 +72,7 @@ theorem discriminate {B : Prop} {n : ℕ} (H1: n = 0 → B) (H2 : ∀m, n = succ
|
|||
|
||||
theorem succ_inj {n m : ℕ} (H : succ n = succ m) : n = m
|
||||
:= calc
|
||||
n = pred (succ n) : symm (pred_succ n)
|
||||
n = pred (succ n) : pred_succ n⁻¹
|
||||
... = pred (succ m) : {H}
|
||||
... = m : pred_succ m
|
||||
|
||||
|
|
@ -123,10 +123,10 @@ theorem sub_induction {P : ℕ → ℕ → Prop} (n m : ℕ) (H1 : ∀m, P 0 m)
|
|||
take m : ℕ,
|
||||
discriminate
|
||||
(assume Hm : m = 0,
|
||||
subst (symm Hm) (H2 k))
|
||||
Hm⁻¹ ▸ (H2 k))
|
||||
(take l : ℕ,
|
||||
assume Hm : m = succ l,
|
||||
subst (symm Hm) (H3 k l (IH l)))),
|
||||
Hm⁻¹ ▸ (H3 k l (IH l)))),
|
||||
general m
|
||||
|
||||
-------------------------------------------------- add
|
||||
|
|
@ -262,7 +262,7 @@ theorem add_one_left (n:ℕ) : 1 + n = succ n
|
|||
--the following theorem has a terrible name, but since the name is not a substring or superstring of another name, it is at least easy to globally replace it
|
||||
theorem induction_plus_one {P : ℕ → Prop} (a : ℕ) (H1 : P 0)
|
||||
(H2 : ∀ (n : ℕ) (IH : P n), P (n + 1)) : P a
|
||||
:= nat_rec H1 (take n IH, subst (add_one n) (H2 n IH)) a
|
||||
:= nat_rec H1 (take n IH, (add_one n) ▸ (H2 n IH)) a
|
||||
|
||||
-------------------------------------------------- mul
|
||||
|
||||
|
|
@ -456,7 +456,7 @@ theorem add_le_left {n m : ℕ} (H : n ≤ m) (k : ℕ) : k + n ≤ k + m
|
|||
... = k + m : { Hl })
|
||||
|
||||
theorem add_le_right {n m : ℕ} (H : n ≤ m) (k : ℕ) : n + k ≤ m + k
|
||||
:= subst (add_comm k m) (subst (add_comm k n) (add_le_left H k))
|
||||
:= (add_comm k m) ▸ (add_comm k n) ▸ (add_le_left H k)
|
||||
|
||||
theorem add_le {n m k l : ℕ} (H1 : n ≤ k) (H2 : m ≤ l) : n + m ≤ k + l
|
||||
:= le_trans (add_le_right H1 m) (add_le_left H2 k)
|
||||
|
|
@ -470,15 +470,15 @@ theorem add_le_left_inv {n m k : ℕ} (H : k + n ≤ k + m) : n ≤ m
|
|||
... = k + m : Hl))
|
||||
|
||||
theorem add_le_right_inv {n m k : ℕ} (H : n + k ≤ m + k) : n ≤ m
|
||||
:= add_le_left_inv (subst (add_comm m k) (subst (add_comm n k) H))
|
||||
:= add_le_left_inv (add_comm m k ▸ add_comm n k ▸ H)
|
||||
|
||||
---------- interaction with succ and pred
|
||||
|
||||
theorem succ_le {n m : ℕ} (H : n ≤ m) : succ n ≤ succ m
|
||||
:= subst (add_one m) (subst (add_one n) (add_le_right H 1))
|
||||
:= add_one m ▸ add_one n ▸ add_le_right H 1
|
||||
|
||||
theorem succ_le_cancel {n m : ℕ} (H : succ n ≤ succ m) : n ≤ m
|
||||
:= add_le_right_inv (subst (symm (add_one m)) (subst (symm (add_one n)) H))
|
||||
:= add_le_right_inv (add_one m⁻¹ ▸ add_one n⁻¹ ▸ H)
|
||||
|
||||
theorem self_le_succ (n : ℕ) : n ≤ succ n
|
||||
:= le_intro (add_one n)
|
||||
|
|
@ -492,8 +492,8 @@ theorem succ_le_left_or {n m : ℕ} (H : n ≤ m) : succ n ≤ m ∨ n = m
|
|||
(assume H3 : k = 0,
|
||||
have Heq : n = m,
|
||||
from calc
|
||||
n = n + 0 : symm (add_zero_right n)
|
||||
... = n + k : {symm H3}
|
||||
n = n + 0 : (add_zero_right n)⁻¹
|
||||
... = n + k : {H3⁻¹}
|
||||
... = m : Hk,
|
||||
or_intro_right _ Heq)
|
||||
(take l:ℕ,
|
||||
|
|
@ -502,7 +502,7 @@ theorem succ_le_left_or {n m : ℕ} (H : n ≤ m) : succ n ≤ m ∨ n = m
|
|||
(le_intro
|
||||
(calc
|
||||
succ n + l = n + succ l : add_move_succ n l
|
||||
... = n + k : {symm H3}
|
||||
... = n + k : {H3⁻¹}
|
||||
... = m : Hk)),
|
||||
or_intro_left _ Hlt)
|
||||
|
||||
|
|
@ -651,7 +651,7 @@ theorem mul_le_left {n m : ℕ} (H : n ≤ m) (k : ℕ) : k * n ≤ k * m
|
|||
show succ l * n ≤ succ l * m, from subst (symm (mul_succ_left l m)) H3)
|
||||
|
||||
theorem mul_le_right {n m : ℕ} (H : n ≤ m) (k : ℕ) : n * k ≤ m * k
|
||||
:= subst (mul_comm k m) (subst (mul_comm k n) (mul_le_left H k))
|
||||
:= mul_comm k m ▸ mul_comm k n ▸ (mul_le_left H k)
|
||||
|
||||
theorem mul_le {n m k l : ℕ} (H1 : n ≤ k) (H2 : m ≤ l) : n * m ≤ k * l
|
||||
:= le_trans (mul_le_right H1 m) (mul_le_left H2 k)
|
||||
|
|
@ -751,10 +751,10 @@ theorem lt_antisym {n m : ℕ} (H : n < m) : ¬ m < n
|
|||
---------- interaction with add
|
||||
|
||||
theorem add_lt_left {n m : ℕ} (H : n < m) (k : ℕ) : k + n < k + m
|
||||
:= subst (add_succ_right k n) (add_le_left H k)
|
||||
:= add_succ_right k n ▸ add_le_left H k
|
||||
|
||||
theorem add_lt_right {n m : ℕ} (H : n < m) (k : ℕ) : n + k < m + k
|
||||
:= subst (add_comm k m) (subst (add_comm k n) (add_lt_left H k))
|
||||
:= add_comm k m ▸ add_comm k n ▸ add_lt_left H k
|
||||
|
||||
theorem add_le_lt {n m k l : ℕ} (H1 : n ≤ k) (H2 : m < l) : n + m < k + l
|
||||
:= le_lt_trans (add_le_right H1 m) (add_lt_left H2 k)
|
||||
|
|
@ -766,18 +766,18 @@ theorem add_lt {n m k l : ℕ} (H1 : n < k) (H2 : m < l) : n + m < k + l
|
|||
:= add_lt_le H1 (lt_imp_le H2)
|
||||
|
||||
theorem add_lt_left_inv {n m k : ℕ} (H : k + n < k + m) : n < m
|
||||
:= add_le_left_inv (subst (symm (add_succ_right k n)) H)
|
||||
:= add_le_left_inv (add_succ_right k n⁻¹ ▸ H)
|
||||
|
||||
theorem add_lt_right_inv {n m k : ℕ} (H : n + k < m + k) : n < m
|
||||
:= add_lt_left_inv (subst (add_comm m k) (subst (add_comm n k) H))
|
||||
:= add_lt_left_inv (add_comm m k ▸ add_comm n k ▸ H)
|
||||
|
||||
---------- interaction with succ (see also the interaction with le)
|
||||
|
||||
theorem succ_lt {n m : ℕ} (H : n < m) : succ n < succ m
|
||||
:= subst (add_one m) (subst (add_one n) (add_lt_right H 1))
|
||||
:= add_one m ▸ add_one n ▸ add_lt_right H 1
|
||||
|
||||
theorem succ_lt_inv {n m : ℕ} (H : succ n < succ m) : n < m
|
||||
:= add_lt_right_inv (subst (symm (add_one m)) (subst (symm (add_one n)) H))
|
||||
:= add_lt_right_inv (add_one m⁻¹ ▸ add_one n⁻¹ ▸ H)
|
||||
|
||||
theorem lt_self_succ (n : ℕ) : n < succ n
|
||||
:= le_refl (succ n)
|
||||
|
|
@ -1024,7 +1024,7 @@ theorem mul_lt_left_inv {n m k : ℕ} (H : k * n < k * m) : n < m
|
|||
induction_on n
|
||||
(take m : ℕ,
|
||||
assume H2 : k * 0 < k * m,
|
||||
have H3 : 0 < k * m, from subst (mul_zero_right k) H2,
|
||||
have H3 : 0 < k * m, from mul_zero_right k ▸ H2,
|
||||
show 0 < m, from mul_positive_inv_right H3)
|
||||
(take l : ℕ,
|
||||
assume IH : ∀ m, k * l < k * m → l < m,
|
||||
|
|
@ -1033,17 +1033,17 @@ theorem mul_lt_left_inv {n m k : ℕ} (H : k * n < k * m) : n < m
|
|||
have H3 : 0 < k * m, from le_lt_trans (zero_le _) H2,
|
||||
have H4 : 0 < m, from mul_positive_inv_right H3,
|
||||
obtain (l2 : ℕ) (Hl2 : m = succ l2), from pos_imp_eq_succ H4,
|
||||
have H5 : k * l + k < k * m, from subst (mul_succ_right k l) H2,
|
||||
have H6 : k * l + k < k * succ l2, from subst Hl2 H5,
|
||||
have H7 : k * l + k < k * l2 + k, from subst (mul_succ_right k l2) H6,
|
||||
have H5 : k * l + k < k * m, from mul_succ_right k l ▸ H2,
|
||||
have H6 : k * l + k < k * succ l2, from Hl2 ▸ H5,
|
||||
have H7 : k * l + k < k * l2 + k, from mul_succ_right k l2 ▸ H6,
|
||||
have H8 : k * l < k * l2, from add_lt_right_inv H7,
|
||||
have H9 : l < l2, from IH l2 H8,
|
||||
have H10 : succ l < succ l2, from succ_lt H9,
|
||||
show succ l < m, from subst (symm Hl2) H10),
|
||||
show succ l < m, from Hl2⁻¹ ▸ H10),
|
||||
general m H
|
||||
|
||||
theorem mul_lt_right_inv {n m k : ℕ} (H : n * k < m * k) : n < m
|
||||
:= mul_lt_left_inv (subst (mul_comm m k) (subst (mul_comm n k) H))
|
||||
:= mul_lt_left_inv (mul_comm m k ▸ mul_comm n k ▸ H)
|
||||
|
||||
theorem mul_le_left_inv {n m k : ℕ} (H : succ k * n ≤ succ k * m) : n ≤ m
|
||||
:=
|
||||
|
|
@ -1173,7 +1173,7 @@ theorem sub_comm (m n k : ℕ) : m - n - k = m - k - n
|
|||
... = m - k - n : symm (sub_sub m k n)
|
||||
|
||||
theorem succ_sub_one (n : ℕ) : succ n - 1 = n
|
||||
:= trans (sub_succ_succ n 0) (sub_zero_right n)
|
||||
:= sub_succ_succ n 0 ⬝ sub_zero_right n
|
||||
|
||||
---------- mul
|
||||
|
||||
|
|
@ -1330,9 +1330,9 @@ theorem sub_sub_split {P : ℕ → ℕ → Prop} {n m : ℕ} (H1 : ∀k, n = m +
|
|||
(H2 : ∀k, m = n + k → P 0 k) : P (n - m) (m - n)
|
||||
:= or_elim (le_total n m)
|
||||
(assume H3 : n ≤ m,
|
||||
subst (symm (le_imp_sub_eq_zero H3)) (H2 (m - n) (symm (add_sub_le H3))))
|
||||
le_imp_sub_eq_zero H3⁻¹ ▸ (H2 (m - n) (add_sub_le H3⁻¹)))
|
||||
(assume H3 : m ≤ n,
|
||||
subst (symm (le_imp_sub_eq_zero H3)) (H1 (n - m) (symm (add_sub_le H3))))
|
||||
le_imp_sub_eq_zero H3⁻¹ ▸ (H1 (n - m) (add_sub_le H3⁻¹)))
|
||||
|
||||
theorem sub_intro {n m k : ℕ} (H : n + m = k) : k - n = m
|
||||
:= have H2 : k - n + n = m + n, from
|
||||
|
|
@ -1352,7 +1352,7 @@ theorem sub_lt {x y : ℕ} (xpos : x > 0) (ypos : y > 0) : x - y < x
|
|||
... = x' - y' : sub_succ_succ _ _,
|
||||
have H1 : x' - y' ≤ x', from sub_le_self _ _,
|
||||
have H2 : x' < succ x', from self_lt_succ _,
|
||||
show x - y < x, from subst (symm xeq) (subst (symm xsuby_eq) (le_lt_trans H1 H2))
|
||||
show x - y < x, from xeq⁻¹ ▸ xsuby_eq⁻¹ ▸ le_lt_trans H1 H2
|
||||
|
||||
-- Max, min, iteration, and absolute difference
|
||||
-- --------------------------------------------
|
||||
|
|
|
|||
Loading…
Reference in a new issue