michael/lean2
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

feat(hott/algebra): port abstract structures

Browse source
This commit is contained in:
Floris van Doorn 2015-12-08 12:57:55 -05:00 committed by Leonardo de Moura
parent 14a2c8e444
commit 46739c8b70
30 changed files with 2903 additions and 1307 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
hott/algebra/algebra.md
View file

@ -1,16 +1,20 @@
algebra
=======
The following files are ported from the standard library. If anything needs to be changed, it is probably a good idea to change it in the standard library and then port the file again (see also [script/port.pl](../../script/port.pl)).
The following files are [ported](port.md) from the standard library. If anything needs to be changed, it is probably a good idea to change it in the standard library and then port the file again (see also [script/port.pl](../../script/port.pl)).
* [binary](binary.hlean) : properties of binary operations
* [relation](relation.hlean) : properties of relations
* [group](group.hlean)
* [ring](ring.hlean)
* [order](order.hlean)
* [ordered_group](ordered_group.hlean)
* [ordered_ring](ordered_ring.hlean)
* [field](field.hlean)
* [priority](priority.lean) : priority for algebraic operations
* [relation](relation.lean)
* [binary](binary.lean) : binary operations
* [order](order.lean)
* [lattice](lattice.lean)
* [group](group.lean)
* [ring](ring.lean)
* [ordered_group](ordered_group.lean)
* [ordered_ring](ordered_ring.lean)
* [field](field.lean)
* [ordered_field](ordered_field.lean)
* [bundled](bundled.lean) : bundled versions of the algebraic structures
Files which are not ported:
@ -19,6 +23,6 @@ Files which are not ported:
* [homotopy_group](homotopy_group.hlean) : homotopy groups of a pointed type
* [e_closure](e_closure.hlean) : the type of words formed by a relation
Subfolders:
Subfolders (not ported):
* [category](category/category.md) : Category Theory

73
hott/algebra/binary.hlean
View file

@ -1,12 +1,11 @@
/-
Copyright (c) 2014-15 Microsoft Corporation. All rights reserved.
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad
General properties of binary operations.
-/
open eq.ops function equiv
open eq.ops function
namespace binary
section
@ -15,31 +14,30 @@ namespace binary
local notation a * b := op₁ a b
local notation a ⁻¹ := inv a
local notation 1 := one
definition commutative [reducible] := ∀a b, a * b = b * a
definition associative [reducible] := ∀a b c, (a * b) * c = a * (b * c)
definition left_identity [reducible] := ∀a, 1 * a = a
definition right_identity [reducible] := ∀a, a * 1 = a
definition left_inverse [reducible] := ∀a, a⁻¹ * a = 1
definition right_inverse [reducible] := ∀a, a * a⁻¹ = 1
definition left_cancelative [reducible] := ∀a b c, a * b = a * c → b = c
definition right_cancelative [reducible] := ∀a b c, a * b = c * b → a = c
definition commutative [reducible] := Πa b, a * b = b * a
definition associative [reducible] := Πa b c, (a * b) * c = a * (b * c)
definition left_identity [reducible] := Πa, one * a = a
definition right_identity [reducible] := Πa, a * one = a
definition left_inverse [reducible] := Πa, a⁻¹ * a = one
definition right_inverse [reducible] := Πa, a * a⁻¹ = one
definition left_cancelative [reducible] := Πa b c, a * b = a * c → b = c
definition right_cancelative [reducible] := Πa b c, a * b = c * b → a = c
definition inv_op_cancel_left [reducible] := ∀a b, a⁻¹ * (a * b) = b
definition op_inv_cancel_left [reducible] := ∀a b, a * (a⁻¹ * b) = b
definition inv_op_cancel_right [reducible] := ∀a b, a * b⁻¹ * b = a
definition op_inv_cancel_right [reducible] := ∀a b, a * b * b⁻¹ = a
definition inv_op_cancel_left [reducible] := Πa b, a⁻¹ * (a * b) = b
definition op_inv_cancel_left [reducible] := Πa b, a * (a⁻¹ * b) = b
definition inv_op_cancel_right [reducible] := Πa b, a * b⁻¹ * b = a
definition op_inv_cancel_right [reducible] := Πa b, a * b * b⁻¹ = a
variable (op₂ : A → A → A)
local notation a + b := op₂ a b
definition left_distributive [reducible] := ∀a b c, a * (b + c) = a * b + a * c
definition right_distributive [reducible] := ∀a b c, (a + b) * c = a * c + b * c
definition left_distributive [reducible] := Πa b c, a * (b + c) = a * b + a * c
definition right_distributive [reducible] := Πa b c, (a + b) * c = a * c + b * c
definition right_commutative [reducible] {B : Type} (f : B → A → B) := ∀ b a₁ a₂, f (f b a₁) a₂ = f (f b a₂) a₁
definition left_commutative [reducible] {B : Type} (f : A → B → B) := ∀ a₁ a₂ b, f a₁ (f a₂ b) = f a₂ (f a₁ b)
definition right_commutative [reducible] {B : Type} (f : B → A → B) := Π b a₁ a₂, f (f b a₁) a₂ = f (f b a₂) a₁
definition left_commutative [reducible] {B : Type} (f : A → B → B) := Π a₁ a₂ b, f a₁ (f a₂ b) = f a₂ (f a₁ b)
end
section
@ -47,7 +45,7 @@ namespace binary
variable {f : A → A → A}
variable H_comm : commutative f
variable H_assoc : associative f
local infixl * := f
local infixl `*` := f
theorem left_comm : left_commutative f :=
take a b c, calc
a*(b*c) = (a*b)*c : H_assoc
@ -71,7 +69,7 @@ namespace binary
variable {A : Type}
variable {f : A → A → A}
variable H_assoc : associative f
local infixl * := f
local infixl `*` := f
theorem assoc4helper (a b c d) : (a*b)*(c*d) = a*((b*c)*d) :=
calc
(a*b)*(c*d) = a*(b*(c*d)) : H_assoc
@ -86,34 +84,3 @@ namespace binary
{A B : Type} (f : A → A → A) (g : B → A) (lcomm : left_commutative f) : left_commutative (compose_left f g) :=
λ a b₁ b₂, !lcomm
end binary
open eq
namespace is_equiv
definition inv_preserve_binary {A B : Type} (f : A → B) [H : is_equiv f]
(mA : A → A → A) (mB : B → B → B) (H : Π(a a' : A), mB (f a) (f a') = f (mA a a'))
(b b' : B) : f⁻¹ (mB b b') = mA (f⁻¹ b) (f⁻¹ b') :=
begin
have H2 : f⁻¹ (mB (f (f⁻¹ b)) (f (f⁻¹ b'))) = f⁻¹ (f (mA (f⁻¹ b) (f⁻¹ b'))), from ap f⁻¹ !H,
rewrite [+right_inv f at H2,left_inv f at H2,▸* at H2,H2]
end
definition preserve_binary_of_inv_preserve {A B : Type} (f : A → B) [H : is_equiv f]
(mA : A → A → A) (mB : B → B → B) (H : Π(b b' : B), mA (f⁻¹ b) (f⁻¹ b') = f⁻¹ (mB b b'))
(a a' : A) : f (mA a a') = mB (f a) (f a') :=
begin
have H2 : f (mA (f⁻¹ (f a)) (f⁻¹ (f a'))) = f (f⁻¹ (mB (f a) (f a'))), from ap f !H,
rewrite [right_inv f at H2,+left_inv f at H2,▸* at H2,H2]
end
end is_equiv
namespace equiv
open is_equiv equiv.ops
definition inv_preserve_binary {A B : Type} (f : A ≃ B)
(mA : A → A → A) (mB : B → B → B) (H : Π(a a' : A), mB (f a) (f a') = f (mA a a'))
(b b' : B) : f⁻¹ (mB b b') = mA (f⁻¹ b) (f⁻¹ b') :=
inv_preserve_binary f mA mB H b b'
definition preserve_binary_of_inv_preserve {A B : Type} (f : A ≃ B)
(mA : A → A → A) (mB : B → B → B) (H : Π(b b' : B), mA (f⁻¹ b) (f⁻¹ b') = f⁻¹ (mB b b'))
(a a' : A) : f (mA a a') = mB (f a) (f a') :=
preserve_binary_of_inv_preserve f mA mB H a a'
end equiv

83
hott/algebra/bundled.hlean Normal file
View file

@ -0,0 +1,83 @@
/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
Bundled structures
-/
import algebra.group
open algebra
namespace algebra
structure Semigroup :=
(carrier : Type) (struct : semigroup carrier)
attribute Semigroup.carrier [coercion]
attribute Semigroup.struct [instance]
structure CommSemigroup :=
(carrier : Type) (struct : comm_semigroup carrier)
attribute CommSemigroup.carrier [coercion]
attribute CommSemigroup.struct [instance]
structure Monoid :=
(carrier : Type) (struct : monoid carrier)
attribute Monoid.carrier [coercion]
attribute Monoid.struct [instance]
structure CommMonoid :=
(carrier : Type) (struct : comm_monoid carrier)
attribute CommMonoid.carrier [coercion]
attribute CommMonoid.struct [instance]
structure Group :=
(carrier : Type) (struct : group carrier)
attribute Group.carrier [coercion]
attribute Group.struct [instance]
structure CommGroup :=
(carrier : Type) (struct : comm_group carrier)
attribute CommGroup.carrier [coercion]
attribute CommGroup.struct [instance]
structure AddSemigroup :=
(carrier : Type) (struct : add_semigroup carrier)
attribute AddSemigroup.carrier [coercion]
attribute AddSemigroup.struct [instance]
structure AddCommSemigroup :=
(carrier : Type) (struct : add_comm_semigroup carrier)
attribute AddCommSemigroup.carrier [coercion]
attribute AddCommSemigroup.struct [instance]
structure AddMonoid :=
(carrier : Type) (struct : add_monoid carrier)
attribute AddMonoid.carrier [coercion]
attribute AddMonoid.struct [instance]
structure AddCommMonoid :=
(carrier : Type) (struct : add_comm_monoid carrier)
attribute AddCommMonoid.carrier [coercion]
attribute AddCommMonoid.struct [instance]
structure AddGroup :=
(carrier : Type) (struct : add_group carrier)
attribute AddGroup.carrier [coercion]
attribute AddGroup.struct [instance]
structure AddCommGroup :=
(carrier : Type) (struct : add_comm_group carrier)
attribute AddCommGroup.carrier [coercion]
attribute AddCommGroup.struct [instance]
end algebra

534
hott/algebra/field.hlean
View file

@ -5,211 +5,204 @@ Authors: Robert Lewis
Structures with multiplicative and additive components, including division rings and fields.
The development is modeled after Isabelle's library.
Ported from the standard library
-/
import algebra.ring
open core
namespace algebra
import algebra.binary algebra.group algebra.ring
open eq eq.ops algebra
set_option class.force_new true
variable {A : Type}
-- in division rings, 1 / 0 = 0
namespace algebra
structure division_ring [class] (A : Type) extends ring A, has_inv A, zero_ne_one_class A :=
(mul_inv_cancel : Π{a}, a ≠ zero → mul a (inv a) = one)
(inv_mul_cancel : Π{a}, a ≠ zero → mul (inv a) a = one)
--(inv_zero : inv zero = zero)
section division_ring
variables [s : division_ring A] {a b c : A}
include s
definition divide (a b : A) : A := a * b⁻¹
infix / := divide
protected definition algebra.div (a b : A) : A := a * b⁻¹
-- only in this file
local attribute divide [reducible]
definition division_ring_has_div [reducible] [instance] : has_div A :=
has_div.mk algebra.div
definition mul_inv_cancel (H : a ≠ 0) : a * a⁻¹ = 1 :=
lemma division.def (a b : A) : a / b = a * b⁻¹ :=
rfl
theorem mul_inv_cancel (H : a ≠ 0) : a * a⁻¹ = 1 :=
division_ring.mul_inv_cancel H
definition inv_mul_cancel (H : a ≠ 0) : a⁻¹ * a = 1 :=
theorem inv_mul_cancel (H : a ≠ 0) : a⁻¹ * a = 1 :=
division_ring.inv_mul_cancel H
definition inv_eq_one_div : a⁻¹ = 1 / a := !one_mul⁻¹
theorem inv_eq_one_div (a : A) : a⁻¹ = 1 / a := !one_mul⁻¹
-- the following are only theorems if we assume inv_zero here
/- definition inv_zero : 0⁻¹ = 0 := !division_ring.inv_zero
theorem div_eq_mul_one_div (a b : A) : a / b = a * (1 / b) :=
by rewrite [*division.def, one_mul]
definition one_div_zero : 1 / 0 = 0 :=
calc
1 / 0 = 1 * 0⁻¹ : refl
... = 1 * 0 : division_ring.inv_zero A
... = 0 : mul_zero
-/
definition div_eq_mul_one_div : a / b = a * (1 / b) :=
by rewrite [↑divide, one_mul]
-- definition div_zero : a / 0 = 0 := by rewrite [div_eq_mul_one_div, one_div_zero, mul_zero]
definition mul_one_div_cancel (H : a ≠ 0) : a * (1 / a) = 1 :=
theorem mul_one_div_cancel (H : a ≠ 0) : a * (1 / a) = 1 :=
by rewrite [-inv_eq_one_div, (mul_inv_cancel H)]
definition one_div_mul_cancel (H : a ≠ 0) : (1 / a) * a = 1 :=
theorem one_div_mul_cancel (H : a ≠ 0) : (1 / a) * a = 1 :=
by rewrite [-inv_eq_one_div, (inv_mul_cancel H)]
definition div_self (H : a ≠ 0) : a / a = 1 := mul_inv_cancel H
theorem div_self (H : a ≠ 0) : a / a = 1 := mul_inv_cancel H
definition one_div_one : 1 / 1 = (1:A) :=
div_self (ne.symm zero_ne_one)
theorem one_div_one : 1 / 1 = (1:A) := div_self (ne.symm zero_ne_one)
definition mul_div_assoc : (a * b) / c = a * (b / c) := !mul.assoc
theorem mul_div_assoc (a b : A) : (a * b) / c = a * (b / c) := !mul.assoc
definition one_div_ne_zero (H : a ≠ 0) : 1 / a ≠ 0 :=
theorem one_div_ne_zero (H : a ≠ 0) : 1 / a ≠ 0 :=
assume H2 : 1 / a = 0,
have C1 : 0 = (1:A), from inverse (by rewrite [-(mul_one_div_cancel H), H2, mul_zero]),
have C1 : 0 = (1:A), from symm (by rewrite [-(mul_one_div_cancel H), H2, mul_zero]),
absurd C1 zero_ne_one
-- definition ne_zero_of_one_div_ne_zero (H : 1 / a ≠ 0) : a ≠ 0 :=
-- assume Ha : a = 0, absurd (Ha⁻¹ ▸ one_div_zero) H
theorem one_inv_eq : 1⁻¹ = (1:A) :=
by rewrite [-mul_one, inv_mul_cancel (ne.symm (@zero_ne_one A _))]
definition inv_one_eq : 1⁻¹ = (1:A) :=
by rewrite [-mul_one, (inv_mul_cancel (ne.symm (@zero_ne_one A _)))]
theorem div_one (a : A) : a / 1 = a :=
by rewrite [*division.def, one_inv_eq, mul_one]
definition div_one : a / 1 = a :=
by rewrite [↑divide, inv_one_eq, mul_one]
theorem zero_div (a : A) : 0 / a = 0 := !zero_mul
definition zero_div : 0 / a = 0 := !zero_mul
-- note: integral domain has a "mul_ne_zero". Discrete fields are int domains.
definition mul_ne_zero' (Ha : a ≠ 0) (Hb : b ≠ 0) : a * b ≠ 0 :=
-- note: integral domain has a "mul_ne_zero". A commutative division ring is an integral
-- domain, but let's not define that class for now.
theorem division_ring.mul_ne_zero (Ha : a ≠ 0) (Hb : b ≠ 0) : a * b ≠ 0 :=
assume H : a * b = 0,
have C1 : a = 0, by rewrite [-mul_one, -(mul_one_div_cancel Hb), -mul.assoc, H, zero_mul],
absurd C1 Ha
definition mul_ne_zero_comm (H : a * b ≠ 0) : b * a ≠ 0 :=
theorem mul_ne_zero_comm (H : a * b ≠ 0) : b * a ≠ 0 :=
have H2 : a ≠ 0 × b ≠ 0, from ne_zero_and_ne_zero_of_mul_ne_zero H,
mul_ne_zero' (prod.pr2 H2) (prod.pr1 H2)
division_ring.mul_ne_zero (prod.pr2 H2) (prod.pr1 H2)
-- make "left" and "right" versions?
definition eq_one_div_of_mul_eq_one (H : a * b = 1) : b = 1 / a :=
have H2 : a ≠ 0, from
(assume aeq0 : a = 0,
have B : 0 = (1:A), by rewrite [-(zero_mul b), -aeq0, H],
absurd B zero_ne_one),
show b = 1 / a, from inverse (calc
theorem eq_one_div_of_mul_eq_one (H : a * b = 1) : b = 1 / a :=
have a ≠ 0, from
(suppose a = 0,
have 0 = (1:A), by rewrite [-(zero_mul b), -this, H],
absurd this zero_ne_one),
show b = 1 / a, from symm (calc
1 / a = (1 / a) * 1 : mul_one
... = (1 / a) * (a * b) : H
... = (1 / a) * a * b : mul.assoc
... = 1 * b : one_div_mul_cancel H2
... = 1 * b : one_div_mul_cancel this
... = b : one_mul)
-- which one is left and which is right?
definition eq_one_div_of_mul_eq_one_left (H : b * a = 1) : b = 1 / a :=
have H2 : a ≠ 0, from
(assume A : a = 0,
have B : 0 = 1, from inverse (calc
1 = b * a : inverse H
... = b * 0 : A
... = 0 : mul_zero),
absurd B zero_ne_one),
show b = 1 / a, from inverse (calc
theorem eq_one_div_of_mul_eq_one_left (H : b * a = 1) : b = 1 / a :=
have a ≠ 0, from
(suppose a = 0,
have 0 = 1, from symm (calc
1 = b * a : symm H
... = b * 0 : this
... = 0 : mul_zero),
absurd this zero_ne_one),
show b = 1 / a, from symm (calc
1 / a = 1 * (1 / a) : one_mul
... = b * a * (1 / a) : H
... = b * (a * (1 / a)) : mul.assoc
... = b * 1 : mul_one_div_cancel H2
... = b * 1 : mul_one_div_cancel this
... = b : mul_one)
definition one_div_mul_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : (1 / a) * (1 / b) = 1 / (b * a) :=
have H : (b * a) * ((1 / a) * (1 / b)) = 1, by
rewrite [mul.assoc, -(mul.assoc a), (mul_one_div_cancel Ha), one_mul, (mul_one_div_cancel Hb)],
eq_one_div_of_mul_eq_one H
theorem division_ring.one_div_mul_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) :
(1 / a) * (1 / b) = 1 / (b * a) :=
have (b * a) * ((1 / a) * (1 / b)) = 1, by
rewrite [mul.assoc, -(mul.assoc a), (mul_one_div_cancel Ha), one_mul,
(mul_one_div_cancel Hb)],
eq_one_div_of_mul_eq_one this
definition one_div_neg_one_eq_neg_one : (1:A) / (-1) = -1 :=
have H : (-1) * (-1) = 1, by rewrite [-neg_eq_neg_one_mul, neg_neg],
inverse (eq_one_div_of_mul_eq_one H)
theorem one_div_neg_one_eq_neg_one : (1:A) / (-1) = -1 :=
have (-1) * (-1) = (1:A), by rewrite [-neg_eq_neg_one_mul, neg_neg],
symm (eq_one_div_of_mul_eq_one this)
definition one_div_neg_eq_neg_one_div (H : a ≠ 0) : 1 / (- a) = - (1 / a) :=
have H1 : -1 ≠ 0, from
(assume H2 : -1 = 0, absurd (inverse (calc
theorem division_ring.one_div_neg_eq_neg_one_div (H : a ≠ 0) : 1 / (- a) = - (1 / a) :=
have -1 ≠ 0, from
(suppose -1 = 0, absurd (symm (calc
1 = -(-1) : neg_neg
... = -0 : H2
... = -0 : this
... = (0:A) : neg_zero)) zero_ne_one),
calc
1 / (- a) = 1 / ((-1) * a) : neg_eq_neg_one_mul
... = (1 / a) * (1 / (- 1)) : one_div_mul_one_div H H1
... = (1 / a) * (1 / (- 1)) : division_ring.one_div_mul_one_div H this
... = (1 / a) * (-1) : one_div_neg_one_eq_neg_one
... = - (1 / a) : mul_neg_one_eq_neg
definition div_neg_eq_neg_div (Ha : a ≠ 0) : b / (- a) = - (b / a) :=
theorem div_neg_eq_neg_div (b : A) (Ha : a ≠ 0) : b / (- a) = - (b / a) :=
calc
b / (- a) = b * (1 / (- a)) : inv_eq_one_div
... = b * -(1 / a) : one_div_neg_eq_neg_one_div Ha
b / (- a) = b * (1 / (- a)) : by rewrite -inv_eq_one_div
... = b * -(1 / a) : division_ring.one_div_neg_eq_neg_one_div Ha
... = -(b * (1 / a)) : neg_mul_eq_mul_neg
... = - (b * a⁻¹) : inv_eq_one_div
definition neg_div (Ha : a ≠ 0) : (-b) / a = - (b / a) :=
theorem neg_div (a b : A) : (-b) / a = - (b / a) :=
by rewrite [neg_eq_neg_one_mul, mul_div_assoc, -neg_eq_neg_one_mul]
definition neg_div_neg_eq_div (Hb : b ≠ 0) : (-a) / (-b) = a / b :=
by rewrite [(div_neg_eq_neg_div Hb), (neg_div Hb), neg_neg]
theorem division_ring.neg_div_neg_eq (a : A) {b : A} (Hb : b ≠ 0) : (-a) / (-b) = a / b :=
by rewrite [(div_neg_eq_neg_div _ Hb), neg_div, neg_neg]
definition div_div (H : a ≠ 0) : 1 / (1 / a) = a :=
inverse (eq_one_div_of_mul_eq_one_left (mul_one_div_cancel H))
theorem division_ring.one_div_one_div (H : a ≠ 0) : 1 / (1 / a) = a :=
symm (eq_one_div_of_mul_eq_one_left (mul_one_div_cancel H))
definition eq_of_invs_eq (Ha : a ≠ 0) (Hb : b ≠ 0) (H : 1 / a = 1 / b) : a = b :=
by rewrite [-(div_div Ha), H, (div_div Hb)]
theorem division_ring.eq_of_one_div_eq_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) (H : 1 / a = 1 / b) :
a = b :=
by rewrite [-(division_ring.one_div_one_div Ha), H, (division_ring.one_div_one_div Hb)]
-- oops, the analogous definition in group is called inv_mul, but it *should* be called
-- mul_inv, in which case, we will have to rename this one
definition mul_inv_eq (Ha : a ≠ 0) (Hb : b ≠ 0) : (b * a)⁻¹ = a⁻¹ * b⁻¹ :=
have H1 : b * a ≠ 0, from mul_ne_zero' Hb Ha,
theorem mul_inv_eq (Ha : a ≠ 0) (Hb : b ≠ 0) : (b * a)⁻¹ = a⁻¹ * b⁻¹ :=
inverse (calc
a⁻¹ * b⁻¹ = (1 / a) * b⁻¹ : inv_eq_one_div
... = (1 / a) * (1 / b) : inv_eq_one_div
... = (1 / (b * a)) : one_div_mul_one_div Ha Hb
... = (b * a)⁻¹ : inv_eq_one_div)
... = (1 / a) * (1 / b) : inv_eq_one_div
... = (1 / (b * a)) : division_ring.one_div_mul_one_div Ha Hb
... = (b * a)⁻¹ : inv_eq_one_div)
definition mul_div_cancel (Hb : b ≠ 0) : a * b / b = a :=
by rewrite [↑divide, mul.assoc, (mul_inv_cancel Hb), mul_one]
theorem mul_div_cancel (a : A) {b : A} (Hb : b ≠ 0) : a * b / b = a :=
by rewrite [*division.def, mul.assoc, (mul_inv_cancel Hb), mul_one]
definition div_mul_cancel (Hb : b ≠ 0) : a / b * b = a :=
by rewrite [↑divide, mul.assoc, (inv_mul_cancel Hb), mul_one]
theorem div_mul_cancel (a : A) {b : A} (Hb : b ≠ 0) : a / b * b = a :=
by rewrite [*division.def, mul.assoc, (inv_mul_cancel Hb), mul_one]
definition div_add_div_same : a / c + b / c = (a + b) / c := !right_distrib⁻¹
theorem div_add_div_same (a b c : A) : a / c + b / c = (a + b) / c := !right_distrib⁻¹
definition inv_mul_add_mul_inv_eq_inv_add_inv (Ha : a ≠ 0) (Hb : b ≠ 0) :
theorem div_sub_div_same (a b c : A) : (a / c) - (b / c) = (a - b) / c :=
by rewrite [sub_eq_add_neg, -neg_div, div_add_div_same]
theorem one_div_mul_add_mul_one_div_eq_one_div_add_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) :
(1 / a) * (a + b) * (1 / b) = 1 / a + 1 / b :=
by rewrite [(left_distrib (1 / a)), (one_div_mul_cancel Ha), right_distrib, one_mul,
mul.assoc, (mul_one_div_cancel Hb), mul_one, add.comm]
definition inv_mul_sub_mul_inv_eq_inv_add_inv (Ha : a ≠ 0) (Hb : b ≠ 0) :
theorem one_div_mul_sub_mul_one_div_eq_one_div_add_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) :
(1 / a) * (b - a) * (1 / b) = 1 / a - 1 / b :=
by rewrite [(mul_sub_left_distrib (1 / a)), (one_div_mul_cancel Ha), mul_sub_right_distrib,
one_mul, mul.assoc, (mul_one_div_cancel Hb), mul_one, one_mul]
one_mul, mul.assoc, (mul_one_div_cancel Hb), mul_one]
definition div_eq_one_iff_eq (Hb : b ≠ 0) : a / b = 1 ↔ a = b :=
theorem div_eq_one_iff_eq (a : A) {b : A} (Hb : b ≠ 0) : a / b = 1 ↔ a = b :=
iff.intro
(assume H1 : a / b = 1, inverse (calc
(suppose a / b = 1, symm (calc
b = 1 * b : one_mul
... = a / b * b : H1
... = a : div_mul_cancel Hb))
(assume H2 : a = b, calc
a / b = b / b : H2
... = a / b * b : this
... = a : div_mul_cancel _ Hb))
(suppose a = b, calc
a / b = b / b : this
... = 1 : div_self Hb)
definition eq_div_iff_mul_eq (Hc : c ≠ 0) : a = b / c ↔ a * c = b :=
theorem eq_of_div_eq_one (a : A) {b : A} (Hb : b ≠ 0) : a / b = 1 → a = b :=
iff.mp (!div_eq_one_iff_eq Hb)
theorem eq_div_iff_mul_eq (a : A) {b : A} (Hc : c ≠ 0) : a = b / c ↔ a * c = b :=
iff.intro
(assume H : a = b / c, by rewrite [H, (div_mul_cancel Hc)])
(assume H : a * c = b, by rewrite [-(mul_div_cancel Hc), H])
(suppose a = b / c, by rewrite [this, (!div_mul_cancel Hc)])
(suppose a * c = b, by rewrite [-(!mul_div_cancel Hc), this])
definition add_div_eq_mul_add_div (Hc : c ≠ 0) : a + b / c = (a * c + b) / c :=
have H : (a + b / c) * c = a * c + b, by rewrite [right_distrib, (div_mul_cancel Hc)],
(iff.elim_right (eq_div_iff_mul_eq Hc)) H
theorem eq_div_of_mul_eq (a b : A) {c : A} (Hc : c ≠ 0) : a * c = b → a = b / c :=
iff.mpr (!eq_div_iff_mul_eq Hc)
definition mul_mul_div (Hc : c ≠ 0) : a = a * c * (1 / c) :=
theorem mul_eq_of_eq_div (a b: A) {c : A} (Hc : c ≠ 0) : a = b / c → a * c = b :=
iff.mp (!eq_div_iff_mul_eq Hc)
theorem add_div_eq_mul_add_div (a b : A) {c : A} (Hc : c ≠ 0) : a + b / c = (a * c + b) / c :=
have (a + b / c) * c = a * c + b, by rewrite [right_distrib, (!div_mul_cancel Hc)],
(iff.elim_right (!eq_div_iff_mul_eq Hc)) this
theorem mul_mul_div (a : A) {c : A} (Hc : c ≠ 0) : a = a * c * (1 / c) :=
calc
a = a * 1 : mul_one
... = a * (c * (1 / c)) : mul_one_div_cancel Hc
@ -217,7 +210,6 @@ section division_ring
-- There are many similar rules to these last two in the Isabelle library
-- that haven't been ported yet. Do as necessary.
end division_ring
structure field [class] (A : Type) extends division_ring A, comm_ring A
@ -225,84 +217,99 @@ structure field [class] (A : Type) extends division_ring A, comm_ring A
section field
variables [s : field A] {a b c d: A}
include s
local attribute divide [reducible]
definition one_div_mul_one_div' (Ha : a ≠ 0) (Hb : b ≠ 0) : (1 / a) * (1 / b) = 1 / (a * b) :=
by rewrite [(one_div_mul_one_div Ha Hb), mul.comm b]
theorem field.one_div_mul_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : (1 / a) * (1 / b) = 1 / (a * b) :=
by rewrite [(division_ring.one_div_mul_one_div Ha Hb), mul.comm b]
definition div_mul_right (Hb : b ≠ 0) (H : a * b ≠ 0) : a / (a * b) = 1 / b :=
let Ha : a ≠ 0 := prod.pr1 (ne_zero_and_ne_zero_of_mul_ne_zero H) in
inverse (calc
theorem field.div_mul_right (Hb : b ≠ 0) (H : a * b ≠ 0) : a / (a * b) = 1 / b :=
have a ≠ 0, from prod.pr1 (ne_zero_and_ne_zero_of_mul_ne_zero H),
symm (calc
1 / b = 1 * (1 / b) : one_mul
... = (a * a⁻¹) * (1 / b) : mul_inv_cancel Ha
... = (a * a⁻¹) * (1 / b) : mul_inv_cancel this
... = a * (a⁻¹ * (1 / b)) : mul.assoc
... = a * ((1 / a) * (1 / b)) :inv_eq_one_div
... = a * (1 / (b * a)) : one_div_mul_one_div Ha Hb
... = a * ((1 / a) * (1 / b)) : inv_eq_one_div
... = a * (1 / (b * a)) : division_ring.one_div_mul_one_div this Hb
... = a * (1 / (a * b)) : mul.comm
... = a * (a * b)⁻¹ : inv_eq_one_div)
definition div_mul_left (Ha : a ≠ 0) (H : a * b ≠ 0) : b / (a * b) = 1 / a :=
theorem field.div_mul_left (Ha : a ≠ 0) (H : a * b ≠ 0) : b / (a * b) = 1 / a :=
let H1 : b * a ≠ 0 := mul_ne_zero_comm H in
by rewrite [mul.comm a, (div_mul_right Ha H1)]
by rewrite [mul.comm a, (field.div_mul_right Ha H1)]
definition mul_div_cancel_left (Ha : a ≠ 0) : a * b / a = b :=
by rewrite [mul.comm a, (mul_div_cancel Ha)]
theorem mul_div_cancel_left (Ha : a ≠ 0) : a * b / a = b :=
by rewrite [mul.comm a, (!mul_div_cancel Ha)]
definition mul_div_cancel' (Hb : b ≠ 0) : b * (a / b) = a :=
by rewrite [mul.comm, (div_mul_cancel Hb)]
theorem mul_div_cancel' (Hb : b ≠ 0) : b * (a / b) = a :=
by rewrite [mul.comm, (!div_mul_cancel Hb)]
definition one_div_add_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : 1 / a + 1 / b = (a + b) / (a * b) :=
have H [visible] : a * b ≠ 0, from (mul_ne_zero' Ha Hb),
by rewrite [add.comm, -(div_mul_left Ha H), -(div_mul_right Hb H), ↑divide, -right_distrib]
theorem one_div_add_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : 1 / a + 1 / b = (a + b) / (a * b) :=
assert a * b ≠ 0, from (division_ring.mul_ne_zero Ha Hb),
by rewrite [add.comm, -(field.div_mul_left Ha this), -(field.div_mul_right Hb this), *division.def,
-right_distrib]
definition div_mul_div (Hb : b ≠ 0) (Hd : d ≠ 0) : (a / b) * (c / d) = (a * c) / (b * d) :=
by rewrite [↑divide, 2 mul.assoc, (mul.comm b⁻¹), mul.assoc, (mul_inv_eq Hd Hb)]
theorem field.div_mul_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0) (Hd : d ≠ 0) :
(a / b) * (c / d) = (a * c) / (b * d) :=
by rewrite [*division.def, 2 mul.assoc, (mul.comm b⁻¹), mul.assoc, (mul_inv_eq Hd Hb)]
definition mul_div_mul_left (Hb : b ≠ 0) (Hc : c ≠ 0) : (c * a) / (c * b) = a / b :=
have H [visible] : c * b ≠ 0, from mul_ne_zero' Hc Hb,
by rewrite [-(div_mul_div Hc Hb), (div_self Hc), one_mul]
theorem mul_div_mul_left (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
(c * a) / (c * b) = a / b :=
by rewrite [-(!field.div_mul_div Hc Hb), (div_self Hc), one_mul]
definition mul_div_mul_right (Hb : b ≠ 0) (Hc : c ≠ 0) : (a * c) / (b * c) = a / b :=
by rewrite [(mul.comm a), (mul.comm b), (mul_div_mul_left Hb Hc)]
theorem mul_div_mul_right (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
(a * c) / (b * c) = a / b :=
by rewrite [(mul.comm a), (mul.comm b), (!mul_div_mul_left Hb Hc)]
definition div_mul_eq_mul_div : (b / c) * a = (b * a) / c :=
by rewrite [↑divide, mul.assoc, (mul.comm c⁻¹), -mul.assoc]
theorem div_mul_eq_mul_div (a b c : A) : (b / c) * a = (b * a) / c :=
by rewrite [*division.def, mul.assoc, (mul.comm c⁻¹), -mul.assoc]
-- this one is odd -- I am not sure what to call it, but again, the prefix is right
definition div_mul_eq_mul_div_comm (Hc : c ≠ 0) : (b / c) * a = b * (a / c) :=
by rewrite [(div_mul_eq_mul_div), -(one_mul c), -(div_mul_div (ne.symm zero_ne_one) Hc), div_one, one_mul]
theorem field.div_mul_eq_mul_div_comm (a b : A) {c : A} (Hc : c ≠ 0) :
(b / c) * a = b * (a / c) :=
by rewrite [(div_mul_eq_mul_div), -(one_mul c), -(!field.div_mul_div (ne.symm zero_ne_one) Hc),
div_one, one_mul]
definition div_add_div (Hb : b ≠ 0) (Hd : d ≠ 0) :
theorem div_add_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0) (Hd : d ≠ 0) :
(a / b) + (c / d) = ((a * d) + (b * c)) / (b * d) :=
have H [visible] : b * d ≠ 0, from mul_ne_zero' Hb Hd,
by rewrite [-(mul_div_mul_right Hb Hd), -(mul_div_mul_left Hd Hb), div_add_div_same]
by rewrite [-(!mul_div_mul_right Hb Hd), -(!mul_div_mul_left Hd Hb), div_add_div_same]
definition div_sub_div (Hb : b ≠ 0) (Hd : d ≠ 0) :
theorem div_sub_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0) (Hd : d ≠ 0) :
(a / b) - (c / d) = ((a * d) - (b * c)) / (b * d) :=
by rewrite [↑sub, neg_eq_neg_one_mul, -mul_div_assoc, (div_add_div Hb Hd),
by rewrite [*sub_eq_add_neg, neg_eq_neg_one_mul, -mul_div_assoc, (!div_add_div Hb Hd),
-mul.assoc, (mul.comm b), mul.assoc, -neg_eq_neg_one_mul]
definition mul_eq_mul_of_div_eq_div (Hb : b ≠ 0) (Hd : d ≠ 0) (H : a / b = c / d) : a * d = c * b :=
theorem mul_eq_mul_of_div_eq_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0)
(Hd : d ≠ 0) (H : a / b = c / d) : a * d = c * b :=
by rewrite [-mul_one, mul.assoc, (mul.comm d), -mul.assoc, -(div_self Hb),
-(div_mul_eq_mul_div_comm Hb), H, (div_mul_eq_mul_div), (div_mul_cancel Hd)]
-(!field.div_mul_eq_mul_div_comm Hb), H, (div_mul_eq_mul_div), (!div_mul_cancel Hd)]
definition one_div_div (Ha : a ≠ 0) (Hb : b ≠ 0) : 1 / (a / b) = b / a :=
have H : (a / b) * (b / a) = 1, from calc
(a / b) * (b / a) = (a * b) / (b * a) : div_mul_div Hb Ha
theorem field.one_div_div (Ha : a ≠ 0) (Hb : b ≠ 0) : 1 / (a / b) = b / a :=
have (a / b) * (b / a) = 1, from calc
(a / b) * (b / a) = (a * b) / (b * a) : !field.div_mul_div Hb Ha
... = (a * b) / (a * b) : mul.comm
... = 1 : div_self (mul_ne_zero' Ha Hb),
inverse (eq_one_div_of_mul_eq_one H)
... = 1 : div_self (division_ring.mul_ne_zero Ha Hb),
symm (eq_one_div_of_mul_eq_one this)
definition div_div_eq_mul_div (Hb : b ≠ 0) (Hc : c ≠ 0) : a / (b / c) = (a * c) / b :=
by rewrite [div_eq_mul_one_div, (one_div_div Hb Hc), -mul_div_assoc]
theorem field.div_div_eq_mul_div (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
a / (b / c) = (a * c) / b :=
by rewrite [div_eq_mul_one_div, (field.one_div_div Hb Hc), -mul_div_assoc]
definition div_div_eq_div_mul (Hb : b ≠ 0) (Hc : c ≠ 0) : (a / b) / c = a / (b * c) :=
by rewrite [div_eq_mul_one_div, (div_mul_div Hb Hc), mul_one]
theorem field.div_div_eq_div_mul (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
(a / b) / c = a / (b * c) :=
by rewrite [div_eq_mul_one_div, (!field.div_mul_div Hb Hc), mul_one]
definition div_div_div_div (Hb : b ≠ 0) (Hc : c ≠ 0) (Hd : d ≠ 0) : (a / b) / (c / d) = (a * d) / (b * c) :=
by rewrite [(div_div_eq_mul_div Hc Hd), (div_mul_eq_mul_div), (div_div_eq_div_mul Hb Hc)]
theorem field.div_div_div_div_eq (a : A) {b c d : A} (Hb : b ≠ 0) (Hc : c ≠ 0) (Hd : d ≠ 0) :
(a / b) / (c / d) = (a * d) / (b * c) :=
by rewrite [(!field.div_div_eq_mul_div Hc Hd), (div_mul_eq_mul_div),
(!field.div_div_eq_div_mul Hb Hc)]
-- remaining to transfer from Isabelle fields: ordered fields
theorem field.div_mul_eq_div_mul_one_div (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
a / (b * c) = (a / b) * (1 / c) :=
by rewrite [-!field.div_div_eq_div_mul Hb Hc, -div_eq_mul_one_div]
theorem eq_of_mul_eq_mul_of_nonzero_left {a b c : A} (H : a ≠ 0) (H2 : a * b = a * c) : b = c :=
by rewrite [-one_mul b, -div_self H, div_mul_eq_mul_div, H2, mul_div_cancel_left H]
theorem eq_of_mul_eq_mul_of_nonzero_right {a b c : A} (H : c ≠ 0) (H2 : a * c = b * c) : a = b :=
by rewrite [-mul_one a, -div_self H, -mul_div_assoc, H2, mul_div_cancel _ H]
end field
@ -319,79 +326,75 @@ section discrete_field
-- many of the theorems in discrete_field are the same as theorems in field or division ring,
-- but with fewer hypotheses since 0⁻¹ = 0 and equality is decidable.
-- they are named with '. Is there a better convention?
definition discrete_field.eq_zero_or_eq_zero_of_mul_eq_zero
theorem discrete_field.eq_zero_or_eq_zero_of_mul_eq_zero
(x y : A) (H : x * y = 0) : x = 0 ⊎ y = 0 :=
decidable.by_cases
(assume H : x = 0, sum.inl H)
(assume H1 : x ≠ 0,
sum.inr (by rewrite [-one_mul, -(inv_mul_cancel H1), mul.assoc, H, mul_zero]))
(suppose x = 0, sum.inl this)
(suppose x ≠ 0,
sum.inr (by rewrite [-one_mul, -(inv_mul_cancel this), mul.assoc, H, mul_zero]))
definition discrete_field.to_integral_domain [instance] [reducible] :
definition discrete_field.to_integral_domain [trans_instance] [reducible] :
integral_domain A :=
⦃ integral_domain, s,
eq_zero_or_eq_zero_of_mul_eq_zero := discrete_field.eq_zero_or_eq_zero_of_mul_eq_zero⦄
definition inv_zero : 0⁻¹ = (0 : A) := !discrete_field.inv_zero
theorem inv_zero : 0⁻¹ = (0:A) := !discrete_field.inv_zero
definition one_div_zero : 1 / 0 = (0:A) :=
theorem one_div_zero : 1 / 0 = (0:A) :=
calc
1 / 0 = 1 * 0⁻¹ : refl
... = 1 * 0 : discrete_field.inv_zero A
... = 1 * 0 : inv_zero
... = 0 : mul_zero
definition div_zero : a / 0 = 0 := by rewrite [div_eq_mul_one_div, one_div_zero, mul_zero]
theorem div_zero (a : A) : a / 0 = 0 := by rewrite [div_eq_mul_one_div, one_div_zero, mul_zero]
definition ne_zero_of_one_div_ne_zero (H : 1 / a ≠ 0) : a ≠ 0 :=
theorem ne_zero_of_one_div_ne_zero (H : 1 / a ≠ 0) : a ≠ 0 :=
assume Ha : a = 0, absurd (Ha⁻¹ ▸ one_div_zero) H
definition inv_zero_imp_zero (H : 1 / a = 0) : a = 0 :=
theorem eq_zero_of_one_div_eq_zero (H : 1 / a = 0) : a = 0 :=
decidable.by_cases
(assume Ha, Ha)
(assume Ha, empty.elim ((one_div_ne_zero Ha) H))
-- the following could all go in "discrete_division_ring"
definition one_div_mul_one_div'' : (1 / a) * (1 / b) = 1 / (b * a) :=
variables (a b)
theorem one_div_mul_one_div' : (1 / a) * (1 / b) = 1 / (b * a) :=
decidable.by_cases
(assume Ha : a = 0,
by rewrite [Ha, div_zero, zero_mul, -(@div_zero A s 1), mul_zero b])
(suppose a = 0,
by rewrite [this, div_zero, zero_mul, -(@div_zero A s 1), mul_zero b])
(assume Ha : a ≠ 0,
decidable.by_cases
(assume Hb : b = 0,
by rewrite [Hb, div_zero, mul_zero, -(@div_zero A s 1), zero_mul a])
(assume Hb : b ≠ 0, one_div_mul_one_div Ha Hb))
(suppose b = 0,
by rewrite [this, div_zero, mul_zero, -(@div_zero A s 1), zero_mul a])
(suppose b ≠ 0, division_ring.one_div_mul_one_div Ha this))
definition one_div_neg_eq_neg_one_div' : 1 / (- a) = - (1 / a) :=
theorem one_div_neg_eq_neg_one_div : 1 / (- a) = - (1 / a) :=
decidable.by_cases
(assume Ha : a = 0, by rewrite [Ha, neg_zero, 2 div_zero, neg_zero])
(assume Ha : a ≠ 0, one_div_neg_eq_neg_one_div Ha)
(suppose a = 0, by rewrite [this, neg_zero, 2 div_zero, neg_zero])
(suppose a ≠ 0, division_ring.one_div_neg_eq_neg_one_div this)
definition neg_div' : (-b) / a = - (b / a) :=
decidable.by_cases
(assume Ha : a = 0, by rewrite [Ha, 2 div_zero, neg_zero])
(assume Ha : a ≠ 0, neg_div Ha)
definition neg_div_neg_eq_div' : (-a) / (-b) = a / b :=
theorem neg_div_neg_eq : (-a) / (-b) = a / b :=
decidable.by_cases
(assume Hb : b = 0, by rewrite [Hb, neg_zero, 2 div_zero])
(assume Hb : b ≠ 0, neg_div_neg_eq_div Hb)
(assume Hb : b ≠ 0, !division_ring.neg_div_neg_eq Hb)
definition div_div' : 1 / (1 / a) = a :=
theorem one_div_one_div : 1 / (1 / a) = a :=
decidable.by_cases
(assume Ha : a = 0, by rewrite [Ha, 2 div_zero])
(assume Ha : a ≠ 0, div_div Ha)
(assume Ha : a ≠ 0, division_ring.one_div_one_div Ha)
definition eq_of_invs_eq' (H : 1 / a = 1 / b) : a = b :=
variables {a b}
theorem eq_of_one_div_eq_one_div (H : 1 / a = 1 / b) : a = b :=
decidable.by_cases
(assume Ha : a = 0,
have Hb : b = 0, from inv_zero_imp_zero (by rewrite [-H, Ha, div_zero]),
have Hb : b = 0, from eq_zero_of_one_div_eq_zero (by rewrite [-H, Ha, div_zero]),
Hb⁻¹ ▸ Ha)
(assume Ha : a ≠ 0,
have Hb : b ≠ 0, from ne_zero_of_one_div_ne_zero (H ▸ (one_div_ne_zero Ha)),
eq_of_invs_eq Ha Hb H)
division_ring.eq_of_one_div_eq_one_div Ha Hb H)
definition mul_inv' : (b * a)⁻¹ = a⁻¹ * b⁻¹ :=
variables (a b)
theorem mul_inv' : (b * a)⁻¹ = a⁻¹ * b⁻¹ :=
decidable.by_cases
(assume Ha : a = 0, by rewrite [Ha, mul_zero, 2 inv_zero, zero_mul])
(assume Ha : a ≠ 0,
@ -400,63 +403,126 @@ section discrete_field
(assume Hb : b ≠ 0, mul_inv_eq Ha Hb))
-- the following are specifically for fields
definition one_div_mul_one_div''' : (1 / a) * (1 / b) = 1 / (a * b) :=
by rewrite [(one_div_mul_one_div''), mul.comm b]
theorem one_div_mul_one_div : (1 / a) * (1 / b) = 1 / (a * b) :=
by rewrite [one_div_mul_one_div', mul.comm b]
definition div_mul_right' (Ha : a ≠ 0) : a / (a * b) = 1 / b :=
variable {a}
theorem div_mul_right (Ha : a ≠ 0) : a / (a * b) = 1 / b :=
decidable.by_cases
(assume Hb : b = 0, by rewrite [Hb, mul_zero, 2 div_zero])
(assume Hb : b ≠ 0, div_mul_right Hb (mul_ne_zero Ha Hb))
(assume Hb : b ≠ 0, field.div_mul_right Hb (mul_ne_zero Ha Hb))
definition div_mul_left' (Hb : b ≠ 0) : b / (a * b) = 1 / a :=
by rewrite [mul.comm a, div_mul_right' Hb]
variables (a) {b}
theorem div_mul_left (Hb : b ≠ 0) : b / (a * b) = 1 / a :=
by rewrite [mul.comm a, div_mul_right _ Hb]
definition div_mul_div' : (a / b) * (c / d) = (a * c) / (b * d) :=
variables (a b c)
theorem div_mul_div : (a / b) * (c / d) = (a * c) / (b * d) :=
decidable.by_cases
(assume Hb : b = 0, by rewrite [Hb, div_zero, zero_mul, -(@div_zero A s (a * c)), zero_mul])
(assume Hb : b ≠ 0,
decidable.by_cases
(assume Hd : d = 0, by rewrite [Hd, div_zero, mul_zero, -(@div_zero A s (a * c)), mul_zero])
(assume Hd : d ≠ 0, div_mul_div Hb Hd))
(assume Hd : d = 0, by rewrite [Hd, div_zero, mul_zero, -(@div_zero A s (a * c)),
mul_zero])
(assume Hd : d ≠ 0, !field.div_mul_div Hb Hd))
definition mul_div_mul_left' (Hc : c ≠ 0) : (c * a) / (c * b) = a / b :=
variable {c}
theorem mul_div_mul_left' (Hc : c ≠ 0) : (c * a) / (c * b) = a / b :=
decidable.by_cases
(assume Hb : b = 0, by rewrite [Hb, mul_zero, 2 div_zero])
(assume Hb : b ≠ 0, mul_div_mul_left Hb Hc)
(assume Hb : b ≠ 0, !mul_div_mul_left Hb Hc)
definition mul_div_mul_right' (Hc : c ≠ 0) : (a * c) / (b * c) = a / b :=
by rewrite [(mul.comm a), (mul.comm b), (mul_div_mul_left' Hc)]
theorem mul_div_mul_right' (Hc : c ≠ 0) : (a * c) / (b * c) = a / b :=
by rewrite [(mul.comm a), (mul.comm b), (!mul_div_mul_left' Hc)]
-- this one is odd -- I am not sure what to call it, but again, the prefix is right
definition div_mul_eq_mul_div_comm' : (b / c) * a = b * (a / c) :=
variables (a b c d)
theorem div_mul_eq_mul_div_comm : (b / c) * a = b * (a / c) :=
decidable.by_cases
(assume Hc : c = 0, by rewrite [Hc, div_zero, zero_mul, -(mul_zero b), -(@div_zero A s a)])
(assume Hc : c ≠ 0, div_mul_eq_mul_div_comm Hc)
(assume Hc : c ≠ 0, !field.div_mul_eq_mul_div_comm Hc)
definition one_div_div' : 1 / (a / b) = b / a :=
theorem one_div_div : 1 / (a / b) = b / a :=
decidable.by_cases
(assume Ha : a = 0, by rewrite [Ha, zero_div, 2 div_zero])
(assume Ha : a ≠ 0,
decidable.by_cases
(assume Hb : b = 0, by rewrite [Hb, 2 div_zero, zero_div])
(assume Hb : b ≠ 0, one_div_div Ha Hb))
(assume Hb : b ≠ 0, field.one_div_div Ha Hb))
definition div_div_eq_mul_div' : a / (b / c) = (a * c) / b :=
by rewrite [div_eq_mul_one_div, one_div_div', -mul_div_assoc]
theorem div_div_eq_mul_div : a / (b / c) = (a * c) / b :=
by rewrite [div_eq_mul_one_div, one_div_div, -mul_div_assoc]
definition div_div_eq_div_mul' : (a / b) / c = a / (b * c) :=
by rewrite [div_eq_mul_one_div, div_mul_div', mul_one]
theorem div_div_eq_div_mul : (a / b) / c = a / (b * c) :=
by rewrite [div_eq_mul_one_div, div_mul_div, mul_one]
definition div_div_div_div' : (a / b) / (c / d) = (a * d) / (b * c) :=
by rewrite [div_div_eq_mul_div', div_mul_eq_mul_div, div_div_eq_div_mul']
theorem div_div_div_div_eq : (a / b) / (c / d) = (a * d) / (b * c) :=
by rewrite [div_div_eq_mul_div, div_mul_eq_mul_div, div_div_eq_div_mul]
variable {a}
theorem div_helper (H : a ≠ 0) : (1 / (a * b)) * a = 1 / b :=
by rewrite [div_mul_eq_mul_div, one_mul, !div_mul_right H]
variable (a)
theorem div_mul_eq_div_mul_one_div : a / (b * c) = (a / b) * (1 / c) :=
by rewrite [-div_div_eq_div_mul, -div_eq_mul_one_div]
end discrete_field
namespace norm_num
theorem div_add_helper [s : field A] (n d b c val : A) (Hd : d ≠ 0) (H : n + b * d = val)
(H2 : c * d = val) : n / d + b = c :=
begin
apply eq_of_mul_eq_mul_of_nonzero_right Hd,
rewrite [H2, -H, right_distrib, div_mul_cancel _ Hd]
end
theorem add_div_helper [s : field A] (n d b c val : A) (Hd : d ≠ 0) (H : d * b + n = val)
(H2 : d * c = val) : b + n / d = c :=
begin
apply eq_of_mul_eq_mul_of_nonzero_left Hd,
rewrite [H2, -H, left_distrib, mul_div_cancel' Hd]
end
theorem div_mul_helper [s : field A] (n d c v : A) (Hd : d ≠ 0) (H : (n * c) / d = v) :
(n / d) * c = v :=
by rewrite [-H, field.div_mul_eq_mul_div_comm _ _ Hd, mul_div_assoc]
theorem mul_div_helper [s : field A] (a n d v : A) (Hd : d ≠ 0) (H : (a * n) / d = v) :
a * (n / d) = v :=
by rewrite [-H, mul_div_assoc]
theorem nonzero_of_div_helper [s : field A] (a b : A) (Ha : a ≠ 0) (Hb : b ≠ 0) : a / b ≠ 0 :=
begin
intro Hab,
have Habb : (a / b) * b = 0, by rewrite [Hab, zero_mul],
rewrite [div_mul_cancel _ Hb at Habb],
exact Ha Habb
end
theorem div_helper [s : field A] (n d v : A) (Hd : d ≠ 0) (H : v * d = n) : n / d = v :=
begin
apply eq_of_mul_eq_mul_of_nonzero_right Hd,
rewrite (div_mul_cancel _ Hd),
exact inverse H
end
theorem div_eq_div_helper [s : field A] (a b c d v : A) (H1 : a * d = v) (H2 : c * b = v)
(Hb : b ≠ 0) (Hd : d ≠ 0) : a / b = c / d :=
begin
apply eq_div_of_mul_eq,
exact Hd,
rewrite div_mul_eq_mul_div,
apply inverse,
apply eq_div_of_mul_eq,
exact Hb,
rewrite [H1, H2]
end
theorem subst_into_div [s : has_div A] (a₁ b₁ a₂ b₂ v : A) (H : a₁ / b₁ = v) (H1 : a₂ = a₁)
(H2 : b₂ = b₁) : a₂ / b₂ = v :=
by rewrite [H1, H2, H]
end norm_num
end algebra
/-
decidable.by_cases
(assume Ha : a = 0, sorry)
(assume Ha : a ≠ 0, sorry)
-/

352
hott/algebra/group.hlean
View file

@ -3,51 +3,29 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura
Various multiplicative and additive structures.
Ported from the standard library
Various multiplicative and additive structures. Partially modeled on Isabelle's library.
-/
import algebra.binary
import algebra.binary algebra.priority
open eq is_trunc binary -- note: ⁻¹ will be overloaded
namespace algebra
open eq eq.ops -- note: ⁻¹ will be overloaded
open binary algebra
set_option class.force_new true
variable {A : Type}
/- overloaded symbols -/
structure has_mul [class] (A : Type) :=
(mul : A → A → A)
structure has_inv [class] (A : Type) :=
(inv : A → A)
structure has_neg [class] (A : Type) :=
(neg : A → A)
infixl * := has_mul.mul
infixl + := has_add.add
postfix ⁻¹ := has_inv.inv
prefix - := has_neg.neg
notation 1 := !has_one.one
notation 0 := !has_zero.zero
--a second notation for the inverse, which is not overloaded
postfix [parsing_only] `⁻¹ᵍ`:std.prec.max_plus := has_inv.inv
/- semigroup -/
structure semigroup [class] (A : Type) extends has_mul A :=
(is_hset_carrier : is_hset A)
(mul_assoc : ∀a b c, mul (mul a b) c = mul a (mul b c))
namespace algebra
attribute semigroup.is_hset_carrier [instance]
structure semigroup [class] (A : Type) extends has_mul A :=
(mul_assoc : Πa b c, mul (mul a b) c = mul a (mul b c))
theorem mul.assoc [s : semigroup A] (a b c : A) : a * b * c = a * (b * c) :=
!semigroup.mul_assoc
structure comm_semigroup [class] (A : Type) extends semigroup A :=
(mul_comm : ∀a b, mul a b = mul b a)
(mul_comm : Πa b, mul a b = mul b a)
theorem mul.comm [s : comm_semigroup A] (a b : A) : a * b = b * a :=
!comm_semigroup.mul_comm
@ -59,7 +37,7 @@ theorem mul.right_comm [s : comm_semigroup A] (a b c : A) : (a * b) * c = (a * c
binary.right_comm (@mul.comm A _) (@mul.assoc A _) a b c
structure left_cancel_semigroup [class] (A : Type) extends semigroup A :=
(mul_left_cancel : ∀a b c, mul a b = mul a c → b = c)
(mul_left_cancel : Πa b c, mul a b = mul a c → b = c)
theorem mul.left_cancel [s : left_cancel_semigroup A] {a b c : A} :
a * b = a * c → b = c :=
@ -68,7 +46,7 @@ theorem mul.left_cancel [s : left_cancel_semigroup A] {a b c : A} :
abbreviation eq_of_mul_eq_mul_left' := @mul.left_cancel
structure right_cancel_semigroup [class] (A : Type) extends semigroup A :=
(mul_right_cancel : ∀a b c, mul a b = mul c b → a = c)
(mul_right_cancel : Πa b c, mul a b = mul c b → a = c)
theorem mul.right_cancel [s : right_cancel_semigroup A] {a b c : A} :
a * b = c * b → a = c :=
@ -79,16 +57,13 @@ abbreviation eq_of_mul_eq_mul_right' := @mul.right_cancel
/- additive semigroup -/
structure add_semigroup [class] (A : Type) extends has_add A :=
(is_hset_carrier : is_hset A)
(add_assoc : ∀a b c, add (add a b) c = add a (add b c))
attribute add_semigroup.is_hset_carrier [instance]
(add_assoc : Πa b c, add (add a b) c = add a (add b c))
theorem add.assoc [s : add_semigroup A] (a b c : A) : a + b + c = a + (b + c) :=
!add_semigroup.add_assoc
structure add_comm_semigroup [class] (A : Type) extends add_semigroup A :=
(add_comm : ∀a b, add a b = add b a)
(add_comm : Πa b, add a b = add b a)
theorem add.comm [s : add_comm_semigroup A] (a b : A) : a + b = b + a :=
!add_comm_semigroup.add_comm
@ -101,7 +76,7 @@ theorem add.right_comm [s : add_comm_semigroup A] (a b c : A) : (a + b) + c = (a
binary.right_comm (@add.comm A _) (@add.assoc A _) a b c
structure add_left_cancel_semigroup [class] (A : Type) extends add_semigroup A :=
(add_left_cancel : ∀a b c, add a b = add a c → b = c)
(add_left_cancel : Πa b c, add a b = add a c → b = c)
theorem add.left_cancel [s : add_left_cancel_semigroup A] {a b c : A} :
a + b = a + c → b = c :=
@ -110,7 +85,7 @@ theorem add.left_cancel [s : add_left_cancel_semigroup A] {a b c : A} :
abbreviation eq_of_add_eq_add_left := @add.left_cancel
structure add_right_cancel_semigroup [class] (A : Type) extends add_semigroup A :=
(add_right_cancel : ∀a b c, add a b = add c b → a = c)
(add_right_cancel : Πa b c, add a b = add c b → a = c)
theorem add.right_cancel [s : add_right_cancel_semigroup A] {a b c : A} :
a + b = c + b → a = c :=
@ -121,7 +96,7 @@ abbreviation eq_of_add_eq_add_right := @add.right_cancel
/- monoid -/
structure monoid [class] (A : Type) extends semigroup A, has_one A :=
(one_mul : ∀a, mul one a = a) (mul_one : ∀a, mul a one = a)
(one_mul : Πa, mul one a = a) (mul_one : Πa, mul a one = a)
theorem one_mul [s : monoid A] (a : A) : 1 * a = a := !monoid.one_mul
@ -132,7 +107,7 @@ structure comm_monoid [class] (A : Type) extends monoid A, comm_semigroup A
/- additive monoid -/
structure add_monoid [class] (A : Type) extends add_semigroup A, has_zero A :=
(zero_add : ∀a, add zero a = a) (add_zero : ∀a, add a zero = a)
(zero_add : Πa, add zero a = a) (add_zero : Πa, add a zero = a)
theorem zero_add [s : add_monoid A] (a : A) : 0 + a = a := !add_monoid.zero_add
@ -140,10 +115,36 @@ theorem add_zero [s : add_monoid A] (a : A) : a + 0 = a := !add_monoid.add_zero
structure add_comm_monoid [class] (A : Type) extends add_monoid A, add_comm_semigroup A
definition add_monoid.to_monoid {A : Type} [s : add_monoid A] : monoid A :=
⦃ monoid,
mul := add_monoid.add,
mul_assoc := add_monoid.add_assoc,
one := add_monoid.zero A,
mul_one := add_monoid.add_zero,
one_mul := add_monoid.zero_add
⦄
definition add_comm_monoid.to_comm_monoid {A : Type} [s : add_comm_monoid A] : comm_monoid A :=
⦃ comm_monoid,
add_monoid.to_monoid,
mul_comm := add_comm_monoid.add_comm
⦄
section add_comm_monoid
variables [s : add_comm_monoid A]
include s
theorem add_comm_three (a b c : A) : a + b + c = c + b + a :=
by rewrite [{a + _}add.comm, {_ + c}add.comm, -*add.assoc]
theorem add.comm4 : Π (n m k l : A), n + m + (k + l) = n + k + (m + l) :=
comm4 add.comm add.assoc
end add_comm_monoid
/- group -/
structure group [class] (A : Type) extends monoid A, has_inv A :=
(mul_left_inv : ∀a, mul (inv a) a = one)
(mul_left_inv : Πa, mul (inv a) a = one)
-- Note: with more work, we could derive the axiom one_mul
@ -163,25 +164,31 @@ section group
theorem inv_eq_of_mul_eq_one {a b : A} (H : a * b = 1) : a⁻¹ = b :=
by rewrite [-mul_one a⁻¹, -H, inv_mul_cancel_left]
theorem one_inv : 1⁻¹ = (1:A) := inv_eq_of_mul_eq_one (one_mul 1)
theorem one_inv : 1⁻¹ = (1 : A) := inv_eq_of_mul_eq_one (one_mul 1)
theorem inv_inv (a : A) : (a⁻¹)⁻¹ = a := inv_eq_of_mul_eq_one (mul.left_inv a)
theorem inv.inj {a b : A} (H : a⁻¹ = b⁻¹) : a = b :=
by rewrite [-inv_inv, H, inv_inv]
by rewrite [-inv_inv a, H, inv_inv b]
theorem inv_eq_inv_iff_eq (a b : A) : a⁻¹ = b⁻¹ ↔ a = b :=
iff.intro (assume H, inv.inj H) (assume H, ap _ H)
theorem inv_eq_one_iff_eq_one (a b : A) : a⁻¹ = 1 ↔ a = 1 :=
theorem inv_eq_one_iff_eq_one (a : A) : a⁻¹ = 1 ↔ a = 1 :=
one_inv ▸ inv_eq_inv_iff_eq a 1
theorem eq_one_of_inv_eq_one (a : A) : a⁻¹ = 1 → a = 1 :=
iff.mp !inv_eq_one_iff_eq_one
theorem eq_inv_of_eq_inv {a b : A} (H : a = b⁻¹) : b = a⁻¹ :=
by rewrite [H, inv_inv]
theorem eq_inv_iff_eq_inv (a b : A) : a = b⁻¹ ↔ b = a⁻¹ :=
iff.intro !eq_inv_of_eq_inv !eq_inv_of_eq_inv
theorem eq_inv_of_mul_eq_one {a b : A} (H : a * b = 1) : a = b⁻¹ :=
begin apply eq_inv_of_eq_inv, symmetry, exact inv_eq_of_mul_eq_one H end
theorem mul.right_inv (a : A) : a * a⁻¹ = 1 :=
calc
a * a⁻¹ = (a⁻¹)⁻¹ * a⁻¹ : inv_inv
@ -254,14 +261,61 @@ section group
theorem mul_eq_one_iff_mul_eq_one (a b : A) : a * b = 1 ↔ b * a = 1 :=
iff.intro !mul_eq_one_of_mul_eq_one !mul_eq_one_of_mul_eq_one
theorem eq_inv_of_mul_eq_one {a b : A} (H : a * b = 1) : a = b⁻¹ :=
(inv_eq_of_mul_eq_one (mul_eq_one_of_mul_eq_one H))⁻¹
definition conj_by (g a : A) := g * a * g⁻¹
definition is_conjugate (a b : A) := Σ x, conj_by x b = a
definition group.to_left_cancel_semigroup [instance] [reducible] : left_cancel_semigroup A :=
local infixl ` ~ ` := is_conjugate
local infixr ` ∘c `:55 := conj_by
lemma conj_compose (f g a : A) : f ∘c g ∘c a = f*g ∘c a :=
calc f ∘c g ∘c a = f * (g * a * g⁻¹) * f⁻¹ : rfl
... = f * (g * a) * g⁻¹ * f⁻¹ : mul.assoc
... = f * g * a * g⁻¹ * f⁻¹ : mul.assoc
... = f * g * a * (g⁻¹ * f⁻¹) : mul.assoc
... = f * g * a * (f * g)⁻¹ : mul_inv
lemma conj_id (a : A) : 1 ∘c a = a :=
calc 1 * a * 1⁻¹ = a * 1⁻¹ : one_mul
... = a * 1 : one_inv
... = a : mul_one
lemma conj_one (g : A) : g ∘c 1 = 1 :=
calc g * 1 * g⁻¹ = g * g⁻¹ : mul_one
... = 1 : mul.right_inv
lemma conj_inv_cancel (g : A) : Π a, g⁻¹ ∘c g ∘c a = a :=
assume a, calc
g⁻¹ ∘c g ∘c a = g⁻¹*g ∘c a : conj_compose
... = 1 ∘c a : mul.left_inv
... = a : conj_id
lemma conj_inv (g : A) : Π a, (g ∘c a)⁻¹ = g ∘c a⁻¹ :=
take a, calc
(g * a * g⁻¹)⁻¹ = g⁻¹⁻¹ * (g * a)⁻¹ : mul_inv
... = g⁻¹⁻¹ * (a⁻¹ * g⁻¹) : mul_inv
... = g⁻¹⁻¹ * a⁻¹ * g⁻¹ : mul.assoc
... = g * a⁻¹ * g⁻¹ : inv_inv
lemma is_conj.refl (a : A) : a ~ a := sigma.mk 1 (conj_id a)
lemma is_conj.symm (a b : A) : a ~ b → b ~ a :=
assume Pab, obtain x (Pconj : x ∘c b = a), from Pab,
assert Pxinv : x⁻¹ ∘c x ∘c b = x⁻¹ ∘c a, begin congruence, assumption end,
sigma.mk x⁻¹ (inverse (conj_inv_cancel x b ▸ Pxinv))
lemma is_conj.trans (a b c : A) : a ~ b → b ~ c → a ~ c :=
assume Pab, assume Pbc,
obtain x (Px : x ∘c b = a), from Pab,
obtain y (Py : y ∘c c = b), from Pbc,
sigma.mk (x*y) (calc
x*y ∘c c = x ∘c y ∘c c : conj_compose
... = x ∘c b : Py
... = a : Px)
definition group.to_left_cancel_semigroup [trans_instance] [reducible] :
left_cancel_semigroup A :=
⦃ left_cancel_semigroup, s,
mul_left_cancel := @mul_left_cancel A s ⦄
definition group.to_right_cancel_semigroup [instance] [reducible] : right_cancel_semigroup A :=
definition group.to_right_cancel_semigroup [trans_instance] [reducible] :
right_cancel_semigroup A :=
⦃ right_cancel_semigroup, s,
mul_right_cancel := @mul_right_cancel A s ⦄
@ -272,7 +326,12 @@ structure comm_group [class] (A : Type) extends group A, comm_monoid A
/- additive group -/
structure add_group [class] (A : Type) extends add_monoid A, has_neg A :=
(add_left_inv : ∀a, add (neg a) a = zero)
(add_left_inv : Πa, add (neg a) a = zero)
definition add_group.to_group {A : Type} [s : add_group A] : group A :=
⦃ group, add_monoid.to_monoid,
mul_left_inv := add_group.add_left_inv ⦄
section add_group
@ -290,7 +349,7 @@ section add_group
theorem neg_eq_of_add_eq_zero {a b : A} (H : a + b = 0) : -a = b :=
by rewrite [-add_zero, -H, neg_add_cancel_left]
theorem neg_zero : -0 = (0:A) := neg_eq_of_add_eq_zero (zero_add 0)
theorem neg_zero : -0 = (0 : A) := neg_eq_of_add_eq_zero (zero_add 0)
theorem neg_neg (a : A) : -(-a) = a := neg_eq_of_add_eq_zero (add.left_inv a)
@ -305,9 +364,15 @@ section add_group
theorem neg_eq_neg_iff_eq (a b : A) : -a = -b ↔ a = b :=
iff.intro (assume H, neg.inj H) (assume H, ap _ H)
theorem eq_of_neg_eq_neg {a b : A} : -a = -b → a = b :=
iff.mp !neg_eq_neg_iff_eq
theorem neg_eq_zero_iff_eq_zero (a : A) : -a = 0 ↔ a = 0 :=
neg_zero ▸ !neg_eq_neg_iff_eq
theorem eq_zero_of_neg_eq_zero {a : A} : -a = 0 → a = 0 :=
iff.mp !neg_eq_zero_iff_eq_zero
theorem eq_neg_of_eq_neg {a b : A} (H : a = -b) : b = -a :=
H⁻¹ ▸ (neg_neg b)⁻¹
@ -372,22 +437,26 @@ section add_group
... = (c + b) + -b : H
... = c : add_neg_cancel_right
definition add_group.to_left_cancel_semigroup [instance] [reducible] :
definition add_group.to_left_cancel_semigroup [trans_instance] [reducible] :
add_left_cancel_semigroup A :=
⦃ add_left_cancel_semigroup, s,
add_left_cancel := @add_left_cancel A s ⦄
definition add_group.to_add_right_cancel_semigroup [instance][reducible] :
definition add_group.to_add_right_cancel_semigroup [trans_instance] [reducible] :
add_right_cancel_semigroup A :=
⦃ add_right_cancel_semigroup, s,
add_right_cancel := @add_right_cancel A s ⦄
theorem add_neg_eq_neg_add_rev {a b : A} : a + -b = -(b + -a) :=
by rewrite [neg_add_rev, neg_neg]
/- sub -/
-- TODO: derive corresponding facts for div in a field
definition sub [reducible] (a b : A) : A := a + -b
protected definition algebra.sub [reducible] (a b : A) : A := a + -b
infix - := sub
definition add_group_has_sub [reducible] [instance] : has_sub A :=
has_sub.mk algebra.sub
theorem sub_eq_add_neg (a b : A) : a - b = a + -b := rfl
@ -408,7 +477,8 @@ section add_group
theorem zero_sub (a : A) : 0 - a = -a := !zero_add
theorem sub_zero (a : A) : a - 0 = a := subst (eq.symm neg_zero) !add_zero
theorem sub_zero (a : A) : a - 0 = a :=
by rewrite [sub_eq_add_neg, neg_zero, add_zero]
theorem sub_neg_eq_add (a b : A) : a - (-b) = a + b :=
by change a + -(-b) = a + b; rewrite neg_neg
@ -416,7 +486,7 @@ section add_group
theorem neg_sub (a b : A) : -(a - b) = b - a :=
neg_eq_of_add_eq_zero
(calc
a - b + (b - a) = a - b + b - a : by rewrite -add.assoc
a - b + (b - a) = a - b + b - a : by krewrite -add.assoc
... = a - a : sub_add_cancel
... = 0 : sub_self)
@ -424,8 +494,8 @@ section add_group
theorem sub_add_eq_sub_sub_swap (a b c : A) : a - (b + c) = a - c - b :=
calc
a - (b + c) = a + (-c - b) : neg_add_rev
... = a - c - b : by rewrite add.assoc
a - (b + c) = a + (-c - b) : by rewrite [sub_eq_add_neg, neg_add_rev]
... = a - c - b : by krewrite -add.assoc
theorem sub_eq_iff_eq_add (a b c : A) : a - b = c ↔ a = c + b :=
iff.intro (assume H, eq_add_of_add_neg_eq H) (assume H, add_neg_eq_of_eq_add H)
@ -450,6 +520,7 @@ section add_group
theorem add_eq_of_eq_sub {a b c : A} (H : a = c - b) : a + b = c :=
add_eq_of_eq_add_neg H
end add_group
structure add_comm_group [class] (A : Type) extends add_group A, add_comm_monoid A
@ -484,6 +555,18 @@ section add_comm_group
theorem add_eq_of_eq_sub' {a b c : A} (H : b = c - a) : a + b = c :=
!add.comm ▸ add_eq_of_eq_sub H
theorem sub_sub_self (a b : A) : a - (a - b) = b :=
by rewrite [sub_eq_add_neg, neg_sub, add.comm, sub_add_cancel]
theorem add_sub_comm (a b c d : A) : a + b - (c + d) = (a - c) + (b - d) :=
by rewrite [sub_add_eq_sub_sub, -sub_add_eq_add_sub a c b, add_sub]
theorem sub_eq_sub_add_sub (a b c : A) : a - b = c - b + (a - c) :=
by rewrite [add_sub, sub_add_cancel] ⬝ !add.comm
theorem neg_neg_sub_neg (a b : A) : - (-a - -b) = a - b :=
by rewrite [neg_sub, sub_neg_eq_add, neg_add_eq_sub]
end add_comm_group
definition group_of_add_group (A : Type) [G : add_group A] : group A :=
@ -494,80 +577,127 @@ definition group_of_add_group (A : Type) [G : add_group A] : group A :=
one_mul := zero_add,
mul_one := add_zero,
inv := has_neg.neg,
mul_left_inv := add.left_inv,
is_hset_carrier := !add_group.is_hset_carrier⦄
mul_left_inv := add.left_inv⦄
/- bundled structures -/
structure Semigroup :=
(carrier : Type) (struct : semigroup carrier)
namespace norm_num
reveal add.assoc
attribute Semigroup.carrier [coercion]
attribute Semigroup.struct [instance]
definition add1 [s : has_add A] [s' : has_one A] (a : A) : A := add a one
structure CommSemigroup :=
(carrier : Type) (struct : comm_semigroup carrier)
theorem add_comm_four [s : add_comm_semigroup A] (a b : A) : a + a + (b + b) = (a + b) + (a + b) :=
by rewrite [-add.assoc at {1}, add.comm, {a + b}add.comm at {1}, *add.assoc]
attribute CommSemigroup.carrier [coercion]
attribute CommSemigroup.struct [instance]
theorem add_comm_middle [s : add_comm_semigroup A] (a b c : A) : a + b + c = a + c + b :=
by rewrite [add.assoc, add.comm b, -add.assoc]
structure Monoid :=
(carrier : Type) (struct : monoid carrier)
theorem bit0_add_bit0 [s : add_comm_semigroup A] (a b : A) : bit0 a + bit0 b = bit0 (a + b) :=
!add_comm_four
attribute Monoid.carrier [coercion]
attribute Monoid.struct [instance]
theorem bit0_add_bit0_helper [s : add_comm_semigroup A] (a b t : A) (H : a + b = t) :
bit0 a + bit0 b = bit0 t :=
by rewrite -H; apply bit0_add_bit0
structure CommMonoid :=
(carrier : Type) (struct : comm_monoid carrier)
theorem bit1_add_bit0 [s : add_comm_semigroup A] [s' : has_one A] (a b : A) :
bit1 a + bit0 b = bit1 (a + b) :=
begin
rewrite [↑bit0, ↑bit1, add_comm_middle], congruence, apply add_comm_four
end
attribute CommMonoid.carrier [coercion]
attribute CommMonoid.struct [instance]
theorem bit1_add_bit0_helper [s : add_comm_semigroup A] [s' : has_one A] (a b t : A)
(H : a + b = t) : bit1 a + bit0 b = bit1 t :=
by rewrite -H; apply bit1_add_bit0
structure Group :=
(carrier : Type) (struct : group carrier)
theorem bit0_add_bit1 [s : add_comm_semigroup A] [s' : has_one A] (a b : A) :
bit0 a + bit1 b = bit1 (a + b) :=
by rewrite [{bit0 a + _}add.comm, {a + _}add.comm]; apply bit1_add_bit0
attribute Group.carrier [coercion]
attribute Group.struct [instance]
theorem bit0_add_bit1_helper [s : add_comm_semigroup A] [s' : has_one A] (a b t : A)
(H : a + b = t) : bit0 a + bit1 b = bit1 t :=
by rewrite -H; apply bit0_add_bit1
structure CommGroup :=
(carrier : Type) (struct : comm_group carrier)
theorem bit1_add_bit1 [s : add_comm_semigroup A] [s' : has_one A] (a b : A) :
bit1 a + bit1 b = bit0 (add1 (a + b)) :=
begin
rewrite ↑[bit0, bit1, add1, add.assoc],
rewrite [*add.assoc, {_ + (b + 1)}add.comm, {_ + (b + 1 + _)}add.comm,
{_ + (b + 1 + _ + _)}add.comm, *add.assoc, {1 + a}add.comm, -{b + (a + 1)}add.assoc,
{b + a}add.comm, *add.assoc]
end
attribute CommGroup.carrier [coercion]
attribute CommGroup.struct [instance]
theorem bit1_add_bit1_helper [s : add_comm_semigroup A] [s' : has_one A] (a b t s: A)
(H : (a + b) = t) (H2 : add1 t = s) : bit1 a + bit1 b = bit0 s :=
begin rewrite [-H2, -H], apply bit1_add_bit1 end
structure AddSemigroup :=
(carrier : Type) (struct : add_semigroup carrier)
theorem bin_add_zero [s : add_monoid A] (a : A) : a + zero = a := !add_zero
attribute AddSemigroup.carrier [coercion]
attribute AddSemigroup.struct [instance]
theorem bin_zero_add [s : add_monoid A] (a : A) : zero + a = a := !zero_add
structure AddCommSemigroup :=
(carrier : Type) (struct : add_comm_semigroup carrier)
theorem one_add_bit0 [s : add_comm_semigroup A] [s' : has_one A] (a : A) : one + bit0 a = bit1 a :=
begin rewrite ↑[bit0, bit1], rewrite add.comm end
attribute AddCommSemigroup.carrier [coercion]
attribute AddCommSemigroup.struct [instance]
theorem bit0_add_one [s : has_add A] [s' : has_one A] (a : A) : bit0 a + one = bit1 a :=
rfl
structure AddMonoid :=
(carrier : Type) (struct : add_monoid carrier)
theorem bit1_add_one [s : has_add A] [s' : has_one A] (a : A) : bit1 a + one = add1 (bit1 a) :=
rfl
attribute AddMonoid.carrier [coercion]
attribute AddMonoid.struct [instance]
theorem bit1_add_one_helper [s : has_add A] [s' : has_one A] (a t : A) (H : add1 (bit1 a) = t) :
bit1 a + one = t :=
by rewrite -H
structure AddCommMonoid :=
(carrier : Type) (struct : add_comm_monoid carrier)
theorem one_add_bit1 [s : add_comm_semigroup A] [s' : has_one A] (a : A) :
one + bit1 a = add1 (bit1 a) := !add.comm
attribute AddCommMonoid.carrier [coercion]
attribute AddCommMonoid.struct [instance]
theorem one_add_bit1_helper [s : add_comm_semigroup A] [s' : has_one A] (a t : A)
(H : add1 (bit1 a) = t) : one + bit1 a = t :=
by rewrite -H; apply one_add_bit1
structure AddGroup :=
(carrier : Type) (struct : add_group carrier)
theorem add1_bit0 [s : has_add A] [s' : has_one A] (a : A) : add1 (bit0 a) = bit1 a :=
rfl
attribute AddGroup.carrier [coercion]
attribute AddGroup.struct [instance]
theorem add1_bit1 [s : add_comm_semigroup A] [s' : has_one A] (a : A) :
add1 (bit1 a) = bit0 (add1 a) :=
begin
rewrite ↑[add1, bit1, bit0],
rewrite [add.assoc, add_comm_four]
end
structure AddCommGroup :=
(carrier : Type) (struct : add_comm_group carrier)
theorem add1_bit1_helper [s : add_comm_semigroup A] [s' : has_one A] (a t : A) (H : add1 a = t) :
add1 (bit1 a) = bit0 t :=
by rewrite -H; apply add1_bit1
attribute AddCommGroup.carrier [coercion]
attribute AddCommGroup.struct [instance]
theorem add1_one [s : has_add A] [s' : has_one A] : add1 (one : A) = bit0 one :=
rfl
theorem add1_zero [s : add_monoid A] [s' : has_one A] : add1 (zero : A) = one :=
begin
rewrite [↑add1, zero_add]
end
theorem one_add_one [s : has_add A] [s' : has_one A] : (one : A) + one = bit0 one :=
rfl
theorem subst_into_sum [s : has_add A] (l r tl tr t : A) (prl : l = tl) (prr : r = tr)
(prt : tl + tr = t) : l + r = t :=
by rewrite [prl, prr, prt]
theorem neg_zero_helper [s : add_group A] (a : A) (H : a = 0) : - a = 0 :=
by rewrite [H, neg_zero]
end norm_num
end algebra
open algebra
attribute [simp]
zero_add add_zero one_mul mul_one
at simplifier.unit
attribute [simp]
neg_neg sub_eq_add_neg
at simplifier.neg
attribute [simp]
add.assoc add.comm add.left_comm
mul.left_comm mul.comm mul.assoc
at simplifier.ac

114
hott/algebra/lattice.hlean Normal file
View file

@ -0,0 +1,114 @@
/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad
-/
import .order
open eq
variable {A : Type}
set_option class.force_new true
/- lattices (we could split this to upper- and lower-semilattices, if needed) -/
namespace algebra
structure lattice [class] (A : Type) extends weak_order A :=
(inf : A → A → A)
(sup : A → A → A)
(inf_le_left : Π a b, le (inf a b) a)
(inf_le_right : Π a b, le (inf a b) b)
(le_inf : Πa b c, le c a → le c b → le c (inf a b))
(le_sup_left : Π a b, le a (sup a b))
(le_sup_right : Π a b, le b (sup a b))
(sup_le : Π a b c, le a c → le b c → le (sup a b) c)
definition inf := @lattice.inf
definition sup := @lattice.sup
infix ` ⊓ `:70 := inf
infix ` ⊔ `:65 := sup
section
variable [s : lattice A]
include s
theorem inf_le_left (a b : A) : a ⊓ b ≤ a := !lattice.inf_le_left
theorem inf_le_right (a b : A) : a ⊓ b ≤ b := !lattice.inf_le_right
theorem le_inf {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) : c ≤ a ⊓ b := !lattice.le_inf H₁ H₂
theorem le_sup_left (a b : A) : a ≤ a ⊔ b := !lattice.le_sup_left
theorem le_sup_right (a b : A) : b ≤ a ⊔ b := !lattice.le_sup_right
theorem sup_le {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) : a ⊔ b ≤ c := !lattice.sup_le H₁ H₂
/- inf -/
theorem eq_inf {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) (H₃ : Π{d}, d ≤ a → d ≤ b → d ≤ c) :
c = a ⊓ b :=
le.antisymm (le_inf H₁ H₂) (H₃ !inf_le_left !inf_le_right)
theorem inf.comm (a b : A) : a ⊓ b = b ⊓ a :=
eq_inf !inf_le_right !inf_le_left (λ c H₁ H₂, le_inf H₂ H₁)
theorem inf.assoc (a b c : A) : (a ⊓ b) ⊓ c = a ⊓ (b ⊓ c) :=
begin
apply eq_inf,
{ apply le.trans, apply inf_le_left, apply inf_le_left },
{ apply le_inf, apply le.trans, apply inf_le_left, apply inf_le_right, apply inf_le_right },
{ intros [d, H₁, H₂], apply le_inf, apply le_inf H₁, apply le.trans H₂, apply inf_le_left,
apply le.trans H₂, apply inf_le_right }
end
theorem inf.left_comm (a b c : A) : a ⊓ (b ⊓ c) = b ⊓ (a ⊓ c) :=
binary.left_comm (@inf.comm A s) (@inf.assoc A s) a b c
theorem inf.right_comm (a b c : A) : (a ⊓ b) ⊓ c = (a ⊓ c) ⊓ b :=
binary.right_comm (@inf.comm A s) (@inf.assoc A s) a b c
theorem inf_self (a : A) : a ⊓ a = a :=
by apply inverse; apply eq_inf (le.refl a) !le.refl; intros; assumption
theorem inf_eq_left {a b : A} (H : a ≤ b) : a ⊓ b = a :=
by apply inverse; apply eq_inf !le.refl H; intros; assumption
theorem inf_eq_right {a b : A} (H : b ≤ a) : a ⊓ b = b :=
eq.subst !inf.comm (inf_eq_left H)
/- sup -/
theorem eq_sup {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) (H₃ : Π{d}, a ≤ d → b ≤ d → c ≤ d) :
c = a ⊔ b :=
le.antisymm (H₃ !le_sup_left !le_sup_right) (sup_le H₁ H₂)
theorem sup.comm (a b : A) : a ⊔ b = b ⊔ a :=
eq_sup !le_sup_right !le_sup_left (λ c H₁ H₂, sup_le H₂ H₁)
theorem sup.assoc (a b c : A) : (a ⊔ b) ⊔ c = a ⊔ (b ⊔ c) :=
begin
apply eq_sup,
{ apply le.trans, apply le_sup_left a b, apply le_sup_left },
{ apply sup_le, apply le.trans, apply le_sup_right a b, apply le_sup_left, apply le_sup_right },
{ intros [d, H₁, H₂], apply sup_le, apply sup_le H₁, apply le.trans !le_sup_left H₂,
apply le.trans !le_sup_right H₂}
end
theorem sup.left_comm (a b c : A) : a ⊔ (b ⊔ c) = b ⊔ (a ⊔ c) :=
binary.left_comm (@sup.comm A s) (@sup.assoc A s) a b c
theorem sup.right_comm (a b c : A) : (a ⊔ b) ⊔ c = (a ⊔ c) ⊔ b :=
binary.right_comm (@sup.comm A s) (@sup.assoc A s) a b c
theorem sup_self (a : A) : a ⊔ a = a :=
by apply inverse; apply eq_sup (le.refl a) !le.refl; intros; assumption
theorem sup_eq_left {a b : A} (H : b ≤ a) : a ⊔ b = a :=
by apply inverse; apply eq_sup !le.refl H; intros; assumption
theorem sup_eq_right {a b : A} (H : a ≤ b) : a ⊔ b = b :=
eq.subst !sup.comm (sup_eq_left H)
end
end algebra

441
hott/algebra/order.hlean
View file

@ -3,45 +3,17 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad
Various types of orders. We develop weak orders "≤" and strict orders "<" separately. We also
consider structures with both, where the two are related by
x < y ↔ (x ≤ y × x ≠ y) (order_pair)
x ≤ y ↔ (x < y ⊎ x = y) (strong_order_pair)
These might not hold constructively in some applications, but we can define additional structures
with both < and ≤ as needed.
Ported from the standard library
Weak orders "≤", strict orders "<", and structures that include both.
-/
--import logic.eq logic.connectives
open core prod
namespace algebra
import algebra.binary algebra.priority
open eq eq.ops algebra
--set_option class.force_new true
variable {A : Type}
/- overloaded symbols -/
structure has_le.{l} [class] (A : Type.{l}) : Type.{l+1} :=
(le : A → A → Type.{l})
structure has_lt [class] (A : Type) :=
(lt : A → A → Type₀)
infixl <= := has_le.le
infixl ≤ := has_le.le
infixl < := has_lt.lt
definition has_le.ge [reducible] {A : Type} [s : has_le A] (a b : A) := b ≤ a
notation a ≥ b := has_le.ge a b
notation a >= b := has_le.ge a b
definition has_lt.gt [reducible] {A : Type} [s : has_lt A] (a b : A) := b < a
notation a > b := has_lt.gt a b
/- weak orders -/
namespace algebra
structure weak_order [class] (A : Type) extends has_le A :=
(le_refl : Πa, le a a)
(le_trans : Πa b c, le a b → le b c → le a c)
@ -51,19 +23,22 @@ section
variable [s : weak_order A]
include s
definition le.refl (a : A) : a ≤ a := !weak_order.le_refl
theorem le.refl (a : A) : a ≤ a := !weak_order.le_refl
definition le.trans [trans] {a b c : A} : a ≤ b → b ≤ c → a ≤ c := !weak_order.le_trans
theorem le.trans [trans] {a b c : A} : a ≤ b → b ≤ c → a ≤ c := !weak_order.le_trans
definition ge.trans [trans] {a b c : A} (H1 : a ≥ b) (H2: b ≥ c) : a ≥ c := le.trans H2 H1
theorem ge.trans [trans] {a b c : A} (H1 : a ≥ b) (H2: b ≥ c) : a ≥ c := le.trans H2 H1
definition le.antisymm {a b : A} : a ≤ b → b ≤ a → a = b := !weak_order.le_antisymm
theorem le.antisymm {a b : A} : a ≤ b → b ≤ a → a = b := !weak_order.le_antisymm
-- Alternate syntax. (Abbreviations do not migrate well.)
theorem eq_of_le_of_ge {a b : A} : a ≤ b → b ≤ a → a = b := !le.antisymm
end
structure linear_weak_order [class] (A : Type) extends weak_order A : Type :=
structure linear_weak_order [class] (A : Type) extends weak_order A :=
(le_total : Πa b, le a b ⊎ le b a)
definition le.total [s : linear_weak_order A] (a b : A) : a ≤ b ⊎ b ≤ a :=
theorem le.total [s : linear_weak_order A] (a b : A) : a ≤ b ⊎ b ≤ a :=
!linear_weak_order.le_total
/- strict orders -/
@ -76,27 +51,31 @@ section
variable [s : strict_order A]
include s
definition lt.irrefl (a : A) : ¬ a < a := !strict_order.lt_irrefl
theorem lt.irrefl (a : A) : ¬ a < a := !strict_order.lt_irrefl
theorem not_lt_self (a : A) : ¬ a < a := !lt.irrefl -- alternate syntax
definition lt.trans [trans] {a b c : A} : a < b → b < c → a < c := !strict_order.lt_trans
theorem lt_self_iff_empty (a : A) : a < a ↔ empty :=
iff_empty_intro (lt.irrefl a)
definition gt.trans [trans] {a b c : A} (H1 : a > b) (H2: b > c) : a > c := lt.trans H2 H1
theorem lt.trans [trans] {a b c : A} : a < b → b < c → a < c := !strict_order.lt_trans
definition ne_of_lt {a b : A} (lt_ab : a < b) : a ≠ b :=
theorem gt.trans [trans] {a b c : A} (H1 : a > b) (H2: b > c) : a > c := lt.trans H2 H1
theorem ne_of_lt {a b : A} (lt_ab : a < b) : a ≠ b :=
assume eq_ab : a = b,
show empty, from lt.irrefl b (eq_ab ▸ lt_ab)
definition ne_of_gt {a b : A} (gt_ab : a > b) : a ≠ b :=
theorem ne_of_gt {a b : A} (gt_ab : a > b) : a ≠ b :=
ne.symm (ne_of_lt gt_ab)
definition lt.asymm {a b : A} (H : a < b) : ¬ b < a :=
theorem lt.asymm {a b : A} (H : a < b) : ¬ b < a :=
assume H1 : b < a, lt.irrefl _ (lt.trans H H1)
theorem not_lt_of_gt {a b : A} (H : a > b) : ¬ a < b := !lt.asymm H -- alternate syntax
end
/- well-founded orders -/
-- TODO: do these duplicate what Leo has done? if so, eliminate
structure wf_strict_order [class] (A : Type) extends strict_order A :=
(wf_rec : ΠP : A → Type, (Πx, (Πy, lt y x → P y) → P x) → Πx, P x)
@ -109,132 +88,104 @@ definition wf.ind_on := @wf.rec_on
/- structures with a weak and a strict order -/
structure order_pair [class] (A : Type) extends weak_order A, has_lt A :=
(lt_iff_le_and_ne : Πa b, lt a b ↔ (le a b × a ≠ b))
(le_of_lt : Π a b, lt a b → le a b)
(lt_of_lt_of_le : Π a b c, lt a b → le b c → lt a c)
(lt_of_le_of_lt : Π a b c, le a b → lt b c → lt a c)
(lt_irrefl : Π a, ¬ lt a a)
section
variable [s : order_pair A]
variables {a b c : A}
include s
definition lt_iff_le_and_ne : a < b ↔ (a ≤ b × a ≠ b) :=
!order_pair.lt_iff_le_and_ne
theorem le_of_lt : a < b → a ≤ b := !order_pair.le_of_lt
definition le_of_lt (H : a < b) : a ≤ b :=
pr1 (iff.mp lt_iff_le_and_ne H)
theorem lt_of_lt_of_le [trans] : a < b → b ≤ c → a < c := !order_pair.lt_of_lt_of_le
definition lt_of_le_of_ne (H1 : a ≤ b) (H2 : a ≠ b) : a < b :=
iff.mp (iff.symm lt_iff_le_and_ne) (pair H1 H2)
theorem lt_of_le_of_lt [trans] : a ≤ b → b < c → a < c := !order_pair.lt_of_le_of_lt
private definition lt_irrefl (s' : order_pair A) (a : A) : ¬ a < a :=
assume H : a < a,
have H1 : a ≠ a, from pr2 (iff.mp !lt_iff_le_and_ne H),
H1 rfl
private theorem lt_irrefl (s' : order_pair A) (a : A) : ¬ a < a := !order_pair.lt_irrefl
private definition lt_trans (s' : order_pair A) (a b c: A) (lt_ab : a < b) (lt_bc : b < c) : a < c :=
have le_ab : a ≤ b, from le_of_lt lt_ab,
have le_bc : b ≤ c, from le_of_lt lt_bc,
have le_ac : a ≤ c, from le.trans le_ab le_bc,
have ne_ac : a ≠ c, from
assume eq_ac : a = c,
have le_ba : b ≤ a, from eq_ac⁻¹ ▸ le_bc,
have eq_ab : a = b, from le.antisymm le_ab le_ba,
have ne_ab : a ≠ b, from pr2 (iff.mp lt_iff_le_and_ne lt_ab),
ne_ab eq_ab,
show a < c, from lt_of_le_of_ne le_ac ne_ac
private theorem lt_trans (s' : order_pair A) (a b c: A) (lt_ab : a < b) (lt_bc : b < c) : a < c :=
lt_of_lt_of_le lt_ab (le_of_lt lt_bc)
definition order_pair.to_strict_order [instance] [reducible] : strict_order A :=
definition order_pair.to_strict_order [trans_instance] [reducible] : strict_order A :=
⦃ strict_order, s, lt_irrefl := lt_irrefl s, lt_trans := lt_trans s ⦄
definition lt_of_lt_of_le [trans] : a < b → b ≤ c → a < c :=
assume lt_ab : a < b,
assume le_bc : b ≤ c,
have le_ac : a ≤ c, from le.trans (le_of_lt lt_ab) le_bc,
have ne_ac : a ≠ c, from
assume eq_ac : a = c,
have le_ba : b ≤ a, from eq_ac⁻¹ ▸ le_bc,
have eq_ab : a = b, from le.antisymm (le_of_lt lt_ab) le_ba,
show empty, from ne_of_lt lt_ab eq_ab,
show a < c, from lt_of_le_of_ne le_ac ne_ac
theorem gt_of_gt_of_ge [trans] (H1 : a > b) (H2 : b ≥ c) : a > c := lt_of_le_of_lt H2 H1
definition lt_of_le_of_lt [trans] : a ≤ b → b < c → a < c :=
assume le_ab : a ≤ b,
assume lt_bc : b < c,
have le_ac : a ≤ c, from le.trans le_ab (le_of_lt lt_bc),
have ne_ac : a ≠ c, from
assume eq_ac : a = c,
have le_cb : c ≤ b, from eq_ac ▸ le_ab,
have eq_bc : b = c, from le.antisymm (le_of_lt lt_bc) le_cb,
show empty, from ne_of_lt lt_bc eq_bc,
show a < c, from lt_of_le_of_ne le_ac ne_ac
theorem gt_of_ge_of_gt [trans] (H1 : a ≥ b) (H2 : b > c) : a > c := lt_of_lt_of_le H2 H1
definition gt_of_gt_of_ge [trans] (H1 : a > b) (H2 : b ≥ c) : a > c := lt_of_le_of_lt H2 H1
definition gt_of_ge_of_gt [trans] (H1 : a ≥ b) (H2 : b > c) : a > c := lt_of_lt_of_le H2 H1
definition not_le_of_lt (H : a < b) : ¬ b ≤ a :=
assume H1 : b ≤ a,
theorem not_le_of_gt (H : a > b) : ¬ a ≤ b :=
assume H1 : a ≤ b,
lt.irrefl _ (lt_of_lt_of_le H H1)
definition not_lt_of_le (H : a ≤ b) : ¬ b < a :=
assume H1 : b < a,
theorem not_lt_of_ge (H : a ≥ b) : ¬ a < b :=
assume H1 : a < b,
lt.irrefl _ (lt_of_le_of_lt H H1)
end
structure strong_order_pair [class] (A : Type) extends order_pair A :=
structure strong_order_pair [class] (A : Type) extends weak_order A, has_lt A :=
(le_iff_lt_or_eq : Πa b, le a b ↔ lt a b ⊎ a = b)
(lt_irrefl : Π a, ¬ lt a a)
definition le_iff_lt_or_eq [s : strong_order_pair A] {a b : A} : a ≤ b ↔ a < b ⊎ a = b :=
theorem le_iff_lt_or_eq [s : strong_order_pair A] {a b : A} : a ≤ b ↔ a < b ⊎ a = b :=
!strong_order_pair.le_iff_lt_or_eq
definition lt_or_eq_of_le [s : strong_order_pair A] {a b : A} (le_ab : a ≤ b) : a < b ⊎ a = b :=
theorem lt_or_eq_of_le [s : strong_order_pair A] {a b : A} (le_ab : a ≤ b) : a < b ⊎ a = b :=
iff.mp le_iff_lt_or_eq le_ab
-- We can also construct a strong order pair by defining a strict order, and then defining
-- x ≤ y ↔ x < y ⊎ x = y
theorem le_of_lt_or_eq [s : strong_order_pair A] {a b : A} (lt_or_eq : a < b ⊎ a = b) : a ≤ b :=
iff.mpr le_iff_lt_or_eq lt_or_eq
structure strict_order_with_le [class] (A : Type) extends strict_order A, has_le A :=
(le_iff_lt_or_eq : Πa b, le a b ↔ lt a b ⊎ a = b)
private theorem lt_irrefl' [s : strong_order_pair A] (a : A) : ¬ a < a :=
!strong_order_pair.lt_irrefl
private definition le_refl (s : strict_order_with_le A) (a : A) : a ≤ a :=
iff.mp (iff.symm !strict_order_with_le.le_iff_lt_or_eq) (sum.inr rfl)
private theorem le_of_lt' [s : strong_order_pair A] (a b : A) : a < b → a ≤ b :=
take Hlt, le_of_lt_or_eq (sum.inl Hlt)
private definition le_trans (s : strict_order_with_le A) (a b c : A) (le_ab : a ≤ b) (le_bc : b ≤ c) : a ≤ c :=
sum.rec_on (iff.mp !strict_order_with_le.le_iff_lt_or_eq le_ab)
(assume lt_ab : a < b,
sum.rec_on (iff.mp !strict_order_with_le.le_iff_lt_or_eq le_bc)
(assume lt_bc : b < c,
iff.elim_right
!strict_order_with_le.le_iff_lt_or_eq (sum.inl (lt.trans lt_ab lt_bc)))
(assume eq_bc : b = c, eq_bc ▸ le_ab))
(assume eq_ab : a = b,
eq_ab⁻¹ ▸ le_bc)
private definition le_antisymm (s : strict_order_with_le A) (a b : A) (le_ab : a ≤ b) (le_ba : b ≤ a) : a = b :=
sum.rec_on (iff.mp !strict_order_with_le.le_iff_lt_or_eq le_ab)
(assume lt_ab : a < b,
sum.rec_on (iff.mp !strict_order_with_le.le_iff_lt_or_eq le_ba)
(assume lt_ba : b < a, absurd (lt.trans lt_ab lt_ba) (lt.irrefl a))
(assume eq_ba : b = a, eq_ba⁻¹))
(assume eq_ab : a = b, eq_ab)
private definition lt_iff_le_ne (s : strict_order_with_le A) (a b : A) : a < b ↔ a ≤ b × a ≠ b :=
private theorem lt_iff_le_and_ne [s : strong_order_pair A] {a b : A} : a < b ↔ (a ≤ b × a ≠ b) :=
iff.intro
(assume lt_ab : a < b,
have le_ab : a ≤ b, from
iff.elim_right !strict_order_with_le.le_iff_lt_or_eq (sum.inl lt_ab),
show a ≤ b × a ≠ b, from pair le_ab (ne_of_lt lt_ab))
(assume H : a ≤ b × a ≠ b,
have H1 : a < b ⊎ a = b, from
iff.mp !strict_order_with_le.le_iff_lt_or_eq (pr1 H),
show a < b, from sum_resolve_left H1 (pr2 H))
(take Hlt, pair (le_of_lt_or_eq (sum.inl Hlt)) (take Hab, absurd (Hab ▸ Hlt) !lt_irrefl'))
(take Hand,
have Hor : a < b ⊎ a = b, from lt_or_eq_of_le (prod.pr1 Hand),
sum_resolve_left Hor (prod.pr2 Hand))
definition strict_order_with_le.to_order_pair [instance] [reducible] [s : strict_order_with_le A] :
strong_order_pair A :=
⦃ strong_order_pair, s,
le_refl := le_refl s,
le_trans := le_trans s,
le_antisymm := le_antisymm s,
lt_iff_le_and_ne := lt_iff_le_ne s ⦄
theorem lt_of_le_of_ne [s : strong_order_pair A] {a b : A} : a ≤ b → a ≠ b → a < b :=
take H1 H2, iff.mpr lt_iff_le_and_ne (pair H1 H2)
private theorem ne_of_lt' [s : strong_order_pair A] {a b : A} (H : a < b) : a ≠ b :=
prod.pr2 (iff.mp (@lt_iff_le_and_ne _ _ _ _) H)
private theorem lt_of_lt_of_le' [s : strong_order_pair A] (a b c : A) : a < b → b ≤ c → a < c :=
assume lt_ab : a < b,
assume le_bc : b ≤ c,
have le_ac : a ≤ c, from le.trans (le_of_lt' _ _ lt_ab) le_bc,
have ne_ac : a ≠ c, from
assume eq_ac : a = c,
have le_ba : b ≤ a, from eq_ac⁻¹ ▸ le_bc,
have eq_ab : a = b, from le.antisymm (le_of_lt' _ _ lt_ab) le_ba,
show empty, from ne_of_lt' lt_ab eq_ab,
show a < c, from iff.mpr (lt_iff_le_and_ne) (pair le_ac ne_ac)
theorem lt_of_le_of_lt' [s : strong_order_pair A] (a b c : A) : a ≤ b → b < c → a < c :=
assume le_ab : a ≤ b,
assume lt_bc : b < c,
have le_ac : a ≤ c, from le.trans le_ab (le_of_lt' _ _ lt_bc),
have ne_ac : a ≠ c, from
assume eq_ac : a = c,
have le_cb : c ≤ b, from eq_ac ▸ le_ab,
have eq_bc : b = c, from le.antisymm (le_of_lt' _ _ lt_bc) le_cb,
show empty, from ne_of_lt' lt_bc eq_bc,
show a < c, from iff.mpr (lt_iff_le_and_ne) (pair le_ac ne_ac)
definition strong_order_pair.to_order_pair [trans_instance] [reducible]
[s : strong_order_pair A] : order_pair A :=
⦃ order_pair, s,
lt_irrefl := lt_irrefl',
le_of_lt := le_of_lt',
lt_of_le_of_lt := lt_of_le_of_lt',
lt_of_lt_of_le := lt_of_lt_of_le' ⦄
/- linear orders -/
@ -243,52 +194,54 @@ structure linear_order_pair [class] (A : Type) extends order_pair A, linear_weak
structure linear_strong_order_pair [class] (A : Type) extends strong_order_pair A,
linear_weak_order A
definition linear_strong_order_pair.to_linear_order_pair [trans_instance] [reducible]
[s : linear_strong_order_pair A] : linear_order_pair A :=
⦃ linear_order_pair, s, strong_order_pair.to_order_pair ⦄
section
variable [s : linear_strong_order_pair A]
variables (a b c : A)
include s
definition lt.trichotomy : a < b ⊎ a = b ⊎ b < a :=
sum.rec_on (le.total a b)
theorem lt.trichotomy : a < b ⊎ a = b ⊎ b < a :=
sum.elim (le.total a b)
(assume H : a ≤ b,
sum.rec_on (iff.mp !le_iff_lt_or_eq H) (assume H1, sum.inl H1) (assume H1, sum.inr (sum.inl H1)))
sum.elim (iff.mp (@le_iff_lt_or_eq _ _ _ _) H) (assume H1, sum.inl H1) (assume H1, sum.inr (sum.inl H1)))
(assume H : b ≤ a,
sum.rec_on (iff.mp !le_iff_lt_or_eq H)
sum.elim (iff.mp (@le_iff_lt_or_eq _ _ _ _) H)
(assume H1, sum.inr (sum.inr H1))
(assume H1, sum.inr (sum.inl (H1⁻¹))))
definition lt.by_cases {a b : A} {P : Type}
theorem lt.by_cases {a b : A} {P : Type}
(H1 : a < b → P) (H2 : a = b → P) (H3 : b < a → P) : P :=
sum.rec_on !lt.trichotomy
sum.elim !lt.trichotomy
(assume H, H1 H)
(assume H, sum.rec_on H (assume H', H2 H') (assume H', H3 H'))
(assume H, sum.elim H (assume H', H2 H') (assume H', H3 H'))
definition linear_strong_order_pair.to_linear_order_pair [instance] [reducible]
: linear_order_pair A :=
⦃ linear_order_pair, s ⦄
definition le_of_not_lt {a b : A} (H : ¬ a < b) : b ≤ a :=
theorem le_of_not_gt {a b : A} (H : ¬ a > b) : a ≤ b :=
lt.by_cases (assume H', absurd H' H) (assume H', H' ▸ !le.refl) (assume H', le_of_lt H')
definition lt_of_not_le {a b : A} (H : ¬ a ≤ b) : b < a :=
theorem lt_of_not_ge {a b : A} (H : ¬ a ≥ b) : a < b :=
lt.by_cases
(assume H', absurd (le_of_lt H') H)
(assume H', absurd (H' ▸ !le.refl) H)
(assume H', H')
definition lt_or_ge : a < b ⊎ a ≥ b :=
theorem lt_or_ge : a < b ⊎ a ≥ b :=
lt.by_cases
(assume H1 : a < b, sum.inl H1)
(assume H1 : a = b, sum.inr (H1 ▸ le.refl a))
(assume H1 : a > b, sum.inr (le_of_lt H1))
definition le_or_gt : a ≤ b ⊎ a > b :=
theorem le_or_gt : a ≤ b ⊎ a > b :=
!sum.swap (lt_or_ge b a)
definition lt_or_gt_of_ne {a b : A} (H : a ≠ b) : a < b ⊎ a > b :=
theorem lt_or_gt_of_ne {a b : A} (H : a ≠ b) : a < b ⊎ a > b :=
lt.by_cases (assume H1, sum.inl H1) (assume H1, absurd H1 H) (assume H1, sum.inr H1)
end
open decidable
structure decidable_linear_order [class] (A : Type) extends linear_strong_order_pair A :=
(decidable_lt : decidable_rel lt)
@ -305,12 +258,12 @@ section
by_cases
(assume H : a < b, inl (le_of_lt H))
(assume H : ¬ a < b,
have H1 : b ≤ a, from le_of_not_lt H,
have H1 : b ≤ a, from le_of_not_gt H,
by_cases
(assume H2 : b < a, inr (not_le_of_lt H2))
(assume H2 : ¬ b < a, inl (le_of_not_lt H2)))
(assume H2 : b < a, inr (not_le_of_gt H2))
(assume H2 : ¬ b < a, inl (le_of_not_gt H2)))
definition decidable_eq [instance] : decidable (a = b) :=
definition has_decidable_eq [instance] : decidable (a = b) :=
by_cases
(assume H : a ≤ b,
by_cases
@ -319,35 +272,161 @@ section
(assume H : ¬ a ≤ b,
(inr (assume H1 : a = b, H (H1 ▸ !le.refl))))
theorem eq_or_lt_of_not_lt {a b : A} (H : ¬ a < b) : a = b ⊎ b < a :=
if Heq : a = b then sum.inl Heq else sum.inr (lt_of_not_ge (λ Hge, H (lt_of_le_of_ne Hge Heq)))
theorem eq_or_lt_of_le {a b : A} (H : a ≤ b) : a = b ⊎ a < b :=
begin
cases eq_or_lt_of_not_lt (not_lt_of_ge H),
exact sum.inl a_1⁻¹,
exact sum.inr a_1
end
-- testing equality first may result in more definitional equalities
definition lt.cases {B : Type} (a b : A) (t_lt t_eq t_gt : B) : B :=
if a = b then t_eq else (if a < b then t_lt else t_gt)
definition lt.cases_of_eq {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a = b) :
theorem lt.cases_of_eq {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a = b) :
lt.cases a b t_lt t_eq t_gt = t_eq := if_pos H
definition lt.cases_of_lt {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a < b) :
theorem lt.cases_of_lt {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a < b) :
lt.cases a b t_lt t_eq t_gt = t_lt :=
if_neg (ne_of_lt H) ⬝ if_pos H
definition lt.cases_of_gt {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a > b) :
theorem lt.cases_of_gt {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a > b) :
lt.cases a b t_lt t_eq t_gt = t_gt :=
if_neg (ne.symm (ne_of_lt H)) ⬝ if_neg (lt.asymm H)
definition min (a b : A) : A := if a ≤ b then a else b
definition max (a b : A) : A := if a ≤ b then b else a
/- these show min and max form a lattice -/
theorem min_le_left (a b : A) : min a b ≤ a :=
by_cases
(assume H : a ≤ b, by rewrite [↑min, if_pos H]; apply le.refl)
(assume H : ¬ a ≤ b, by rewrite [↑min, if_neg H]; apply le_of_lt (lt_of_not_ge H))
theorem min_le_right (a b : A) : min a b ≤ b :=
by_cases
(assume H : a ≤ b, by rewrite [↑min, if_pos H]; apply H)
(assume H : ¬ a ≤ b, by rewrite [↑min, if_neg H]; apply le.refl)
theorem le_min {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) : c ≤ min a b :=
by_cases
(assume H : a ≤ b, by rewrite [↑min, if_pos H]; apply H₁)
(assume H : ¬ a ≤ b, by rewrite [↑min, if_neg H]; apply H₂)
theorem le_max_left (a b : A) : a ≤ max a b :=
by_cases
(assume H : a ≤ b, by rewrite [↑max, if_pos H]; apply H)
(assume H : ¬ a ≤ b, by rewrite [↑max, if_neg H]; apply le.refl)
theorem le_max_right (a b : A) : b ≤ max a b :=
by_cases
(assume H : a ≤ b, by rewrite [↑max, if_pos H]; apply le.refl)
(assume H : ¬ a ≤ b, by rewrite [↑max, if_neg H]; apply le_of_lt (lt_of_not_ge H))
theorem max_le {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) : max a b ≤ c :=
by_cases
(assume H : a ≤ b, by rewrite [↑max, if_pos H]; apply H₂)
(assume H : ¬ a ≤ b, by rewrite [↑max, if_neg H]; apply H₁)
theorem le_max_left_iff_unit (a b : A) : a ≤ max a b ↔ unit :=
iff_unit_intro (le_max_left a b)
theorem le_max_right_iff_unit (a b : A) : b ≤ max a b ↔ unit :=
iff_unit_intro (le_max_right a b)
/- these are also proved for lattices, but with inf and sup in place of min and max -/
theorem eq_min {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) (H₃ : Π{d}, d ≤ a → d ≤ b → d ≤ c) :
c = min a b :=
le.antisymm (le_min H₁ H₂) (H₃ !min_le_left !min_le_right)
theorem min.comm (a b : A) : min a b = min b a :=
eq_min !min_le_right !min_le_left (λ c H₁ H₂, le_min H₂ H₁)
theorem min.assoc (a b c : A) : min (min a b) c = min a (min b c) :=
begin
apply eq_min,
{ apply le.trans, apply min_le_left, apply min_le_left },
{ apply le_min, apply le.trans, apply min_le_left, apply min_le_right, apply min_le_right },
{ intros [d, H₁, H₂], apply le_min, apply le_min H₁, apply le.trans H₂, apply min_le_left,
apply le.trans H₂, apply min_le_right }
end
theorem min.left_comm (a b c : A) : min a (min b c) = min b (min a c) :=
binary.left_comm (@min.comm A s) (@min.assoc A s) a b c
theorem min.right_comm (a b c : A) : min (min a b) c = min (min a c) b :=
binary.right_comm (@min.comm A s) (@min.assoc A s) a b c
theorem min_self (a : A) : min a a = a :=
by apply inverse; apply eq_min (le.refl a) !le.refl; intros; assumption
theorem min_eq_left {a b : A} (H : a ≤ b) : min a b = a :=
by apply inverse; apply eq_min !le.refl H; intros; assumption
theorem min_eq_right {a b : A} (H : b ≤ a) : min a b = b :=
eq.subst !min.comm (min_eq_left H)
theorem eq_max {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) (H₃ : Π{d}, a ≤ d → b ≤ d → c ≤ d) :
c = max a b :=
le.antisymm (H₃ !le_max_left !le_max_right) (max_le H₁ H₂)
theorem max.comm (a b : A) : max a b = max b a :=
eq_max !le_max_right !le_max_left (λ c H₁ H₂, max_le H₂ H₁)
theorem max.assoc (a b c : A) : max (max a b) c = max a (max b c) :=
begin
apply eq_max,
{ apply le.trans, apply le_max_left a b, apply le_max_left },
{ apply max_le, apply le.trans, apply le_max_right a b, apply le_max_left, apply le_max_right },
{ intros [d, H₁, H₂], apply max_le, apply max_le H₁, apply le.trans !le_max_left H₂,
apply le.trans !le_max_right H₂}
end
theorem max.left_comm (a b c : A) : max a (max b c) = max b (max a c) :=
binary.left_comm (@max.comm A s) (@max.assoc A s) a b c
theorem max.right_comm (a b c : A) : max (max a b) c = max (max a c) b :=
binary.right_comm (@max.comm A s) (@max.assoc A s) a b c
theorem max_self (a : A) : max a a = a :=
by apply inverse; apply eq_max (le.refl a) !le.refl; intros; assumption
theorem max_eq_left {a b : A} (H : b ≤ a) : max a b = a :=
by apply inverse; apply eq_max !le.refl H; intros; assumption
theorem max_eq_right {a b : A} (H : a ≤ b) : max a b = b :=
eq.subst !max.comm (max_eq_left H)
/- these rely on lt_of_lt -/
theorem min_eq_left_of_lt {a b : A} (H : a < b) : min a b = a :=
min_eq_left (le_of_lt H)
theorem min_eq_right_of_lt {a b : A} (H : b < a) : min a b = b :=
min_eq_right (le_of_lt H)
theorem max_eq_left_of_lt {a b : A} (H : b < a) : max a b = a :=
max_eq_left (le_of_lt H)
theorem max_eq_right_of_lt {a b : A} (H : a < b) : max a b = b :=
max_eq_right (le_of_lt H)
/- these use the fact that it is a linear ordering -/
theorem lt_min {a b c : A} (H₁ : a < b) (H₂ : a < c) : a < min b c :=
sum.elim !le_or_gt
(assume H : b ≤ c, by rewrite (min_eq_left H); apply H₁)
(assume H : b > c, by rewrite (min_eq_right_of_lt H); apply H₂)
theorem max_lt {a b c : A} (H₁ : a < c) (H₂ : b < c) : max a b < c :=
sum.elim !le_or_gt
(assume H : a ≤ b, by rewrite (max_eq_right H); apply H₂)
(assume H : a > b, by rewrite (max_eq_left_of_lt H); apply H₁)
end
end algebra
/-
For reference, these are all the transitivity rules defined in this file:
calc_trans le.trans
calc_trans lt.trans
calc_trans lt_of_lt_of_le
calc_trans lt_of_le_of_lt
calc_trans ge.trans
calc_trans gt.trans
calc_trans gt_of_gt_of_ge
calc_trans gt_of_ge_of_gt
-/

518
hott/algebra/ordered_field.hlean Normal file
View file

@ -0,0 +1,518 @@
/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Lewis
-/
import algebra.ordered_ring algebra.field
open eq eq.ops algebra
namespace algebra
structure linear_ordered_field [class] (A : Type) extends linear_ordered_ring A, field A
section linear_ordered_field
variable {A : Type}
variables [s : linear_ordered_field A] {a b c d : A}
include s
-- helpers for following
theorem mul_zero_lt_mul_inv_of_pos (H : 0 < a) : a * 0 < a * (1 / a) :=
calc
a * 0 = 0 : mul_zero
... < 1 : zero_lt_one
... = a * a⁻¹ : mul_inv_cancel (ne.symm (ne_of_lt H))
... = a * (1 / a) : inv_eq_one_div
theorem mul_zero_lt_mul_inv_of_neg (H : a < 0) : a * 0 < a * (1 / a) :=
calc
a * 0 = 0 : mul_zero
... < 1 : zero_lt_one
... = a * a⁻¹ : mul_inv_cancel (ne_of_lt H)
... = a * (1 / a) : inv_eq_one_div
theorem one_div_pos_of_pos (H : 0 < a) : 0 < 1 / a :=
lt_of_mul_lt_mul_left (mul_zero_lt_mul_inv_of_pos H) (le_of_lt H)
theorem one_div_neg_of_neg (H : a < 0) : 1 / a < 0 :=
gt_of_mul_lt_mul_neg_left (mul_zero_lt_mul_inv_of_neg H) (le_of_lt H)
theorem le_mul_of_ge_one_right (Hb : b ≥ 0) (H : a ≥ 1) : b ≤ b * a :=
mul_one _ ▸ (mul_le_mul_of_nonneg_left H Hb)
theorem lt_mul_of_gt_one_right (Hb : b > 0) (H : a > 1) : b < b * a :=
mul_one _ ▸ (mul_lt_mul_of_pos_left H Hb)
theorem one_le_div_iff_le (a : A) {b : A} (Hb : b > 0) : 1 ≤ a / b ↔ b ≤ a :=
have Hb' : b ≠ 0, from ne.symm (ne_of_lt Hb),
iff.intro
(assume H : 1 ≤ a / b,
calc
b = b : refl
... ≤ b * (a / b) : le_mul_of_ge_one_right (le_of_lt Hb) H
... = a : mul_div_cancel' Hb')
(assume H : b ≤ a,
have Hbinv : 1 / b > 0, from one_div_pos_of_pos Hb, calc
1 = b * (1 / b) : mul_one_div_cancel Hb'
... ≤ a * (1 / b) : mul_le_mul_of_nonneg_right H (le_of_lt Hbinv)
... = a / b : div_eq_mul_one_div)
theorem le_of_one_le_div (Hb : b > 0) (H : 1 ≤ a / b) : b ≤ a :=
(iff.mp (!one_le_div_iff_le Hb)) H
theorem one_le_div_of_le (Hb : b > 0) (H : b ≤ a) : 1 ≤ a / b :=
(iff.mpr (!one_le_div_iff_le Hb)) H
theorem one_lt_div_iff_lt (a : A) {b : A} (Hb : b > 0) : 1 < a / b ↔ b < a :=
have Hb' : b ≠ 0, from ne.symm (ne_of_lt Hb),
iff.intro
(assume H : 1 < a / b,
calc
b < b * (a / b) : lt_mul_of_gt_one_right Hb H
... = a : mul_div_cancel' Hb')
(assume H : b < a,
have Hbinv : 1 / b > 0, from one_div_pos_of_pos Hb, calc
1 = b * (1 / b) : mul_one_div_cancel Hb'
... < a * (1 / b) : mul_lt_mul_of_pos_right H Hbinv
... = a / b : div_eq_mul_one_div)
theorem lt_of_one_lt_div (Hb : b > 0) (H : 1 < a / b) : b < a :=
(iff.mp (!one_lt_div_iff_lt Hb)) H
theorem one_lt_div_of_lt (Hb : b > 0) (H : b < a) : 1 < a / b :=
(iff.mpr (!one_lt_div_iff_lt Hb)) H
theorem exists_lt (a : A) : Σ x, x < a :=
have H : a - 1 < a, from add_lt_of_le_of_neg (le.refl _) zero_gt_neg_one,
sigma.mk _ H
theorem exists_gt (a : A) : Σ x, x > a :=
have H : a + 1 > a, from lt_add_of_le_of_pos (le.refl _) zero_lt_one,
sigma.mk _ H
-- the following theorems amount to four iffs, for <, ≤, ≥, >.
theorem mul_le_of_le_div (Hc : 0 < c) (H : a ≤ b / c) : a * c ≤ b :=
!div_mul_cancel (ne.symm (ne_of_lt Hc)) ▸ mul_le_mul_of_nonneg_right H (le_of_lt Hc)
theorem le_div_of_mul_le (Hc : 0 < c) (H : a * c ≤ b) : a ≤ b / c :=
calc
a = a * c * (1 / c) : !mul_mul_div (ne.symm (ne_of_lt Hc))
... ≤ b * (1 / c) : mul_le_mul_of_nonneg_right H (le_of_lt (one_div_pos_of_pos Hc))
... = b / c : div_eq_mul_one_div
theorem mul_lt_of_lt_div (Hc : 0 < c) (H : a < b / c) : a * c < b :=
!div_mul_cancel (ne.symm (ne_of_lt Hc)) ▸ mul_lt_mul_of_pos_right H Hc
theorem lt_div_of_mul_lt (Hc : 0 < c) (H : a * c < b) : a < b / c :=
calc
a = a * c * (1 / c) : !mul_mul_div (ne.symm (ne_of_lt Hc))
... < b * (1 / c) : mul_lt_mul_of_pos_right H (one_div_pos_of_pos Hc)
... = b / c : div_eq_mul_one_div
theorem mul_le_of_div_le_of_neg (Hc : c < 0) (H : b / c ≤ a) : a * c ≤ b :=
!div_mul_cancel (ne_of_lt Hc) ▸ mul_le_mul_of_nonpos_right H (le_of_lt Hc)
theorem div_le_of_mul_le_of_neg (Hc : c < 0) (H : a * c ≤ b) : b / c ≤ a :=
calc
a = a * c * (1 / c) : !mul_mul_div (ne_of_lt Hc)
... ≥ b * (1 / c) : mul_le_mul_of_nonpos_right H (le_of_lt (one_div_neg_of_neg Hc))
... = b / c : div_eq_mul_one_div
theorem mul_lt_of_gt_div_of_neg (Hc : c < 0) (H : a > b / c) : a * c < b :=
!div_mul_cancel (ne_of_lt Hc) ▸ mul_lt_mul_of_neg_right H Hc
theorem div_lt_of_mul_gt_of_neg (Hc : c < 0) (H : a * c < b) : b / c < a :=
calc
a = a * c * (1 / c) : !mul_mul_div (ne_of_lt Hc)
... > b * (1 / c) : mul_lt_mul_of_neg_right H (one_div_neg_of_neg Hc)
... = b / c : div_eq_mul_one_div
theorem div_le_of_le_mul (Hb : b > 0) (H : a ≤ b * c) : a / b ≤ c :=
calc
a / b = a * (1 / b) : div_eq_mul_one_div
... ≤ (b * c) * (1 / b) : mul_le_mul_of_nonneg_right H (le_of_lt (one_div_pos_of_pos Hb))
... = (b * c) / b : div_eq_mul_one_div
... = c : mul_div_cancel_left (ne.symm (ne_of_lt Hb))
theorem le_mul_of_div_le (Hc : c > 0) (H : a / c ≤ b) : a ≤ b * c :=
calc
a = a / c * c : !div_mul_cancel (ne.symm (ne_of_lt Hc))
... ≤ b * c : mul_le_mul_of_nonneg_right H (le_of_lt Hc)
-- following these in the isabelle file, there are 8 biconditionals for the above with - signs
-- skipping for now
theorem mul_sub_mul_div_mul_neg (Hc : c ≠ 0) (Hd : d ≠ 0) (H : a / c < b / d) :
(a * d - b * c) / (c * d) < 0 :=
have H1 : a / c - b / d < 0, from calc
a / c - b / d < b / d - b / d : sub_lt_sub_right H
... = 0 : sub_self,
calc
0 > a / c - b / d : H1
... = (a * d - c * b) / (c * d) : !div_sub_div Hc Hd
... = (a * d - b * c) / (c * d) : mul.comm
theorem mul_sub_mul_div_mul_nonpos (Hc : c ≠ 0) (Hd : d ≠ 0) (H : a / c ≤ b / d) :
(a * d - b * c) / (c * d) ≤ 0 :=
have H1 : a / c - b / d ≤ 0, from calc
a / c - b / d ≤ b / d - b / d : sub_le_sub_right H
... = 0 : sub_self,
calc
0 ≥ a / c - b / d : H1
... = (a * d - c * b) / (c * d) : !div_sub_div Hc Hd
... = (a * d - b * c) / (c * d) : mul.comm
theorem div_lt_div_of_mul_sub_mul_div_neg (Hc : c ≠ 0) (Hd : d ≠ 0)
(H : (a * d - b * c) / (c * d) < 0) : a / c < b / d :=
assert H1 : (a * d - c * b) / (c * d) < 0, by rewrite [mul.comm c b]; exact H,
assert H2 : a / c - b / d < 0, by rewrite [!div_sub_div Hc Hd]; exact H1,
assert H3 : a / c - b / d + b / d < 0 + b / d, from add_lt_add_right H2 _,
begin rewrite [zero_add at H3, sub_eq_add_neg at H3, neg_add_cancel_right at H3], exact H3 end
theorem div_le_div_of_mul_sub_mul_div_nonpos (Hc : c ≠ 0) (Hd : d ≠ 0)
(H : (a * d - b * c) / (c * d) ≤ 0) : a / c ≤ b / d :=
assert H1 : (a * d - c * b) / (c * d) ≤ 0, by rewrite [mul.comm c b]; exact H,
assert H2 : a / c - b / d ≤ 0, by rewrite [!div_sub_div Hc Hd]; exact H1,
assert H3 : a / c - b / d + b / d ≤ 0 + b / d, from add_le_add_right H2 _,
begin rewrite [zero_add at H3, sub_eq_add_neg at H3, neg_add_cancel_right at H3], exact H3 end
theorem div_pos_of_pos_of_pos (Ha : 0 < a) (Hb : 0 < b) : 0 < a / b :=
begin
rewrite div_eq_mul_one_div,
apply mul_pos,
exact Ha,
apply one_div_pos_of_pos,
exact Hb
end
theorem div_nonneg_of_nonneg_of_pos (Ha : 0 ≤ a) (Hb : 0 < b) : 0 ≤ a / b :=
begin
rewrite div_eq_mul_one_div,
apply mul_nonneg,
exact Ha,
apply le_of_lt,
apply one_div_pos_of_pos,
exact Hb
end
theorem div_neg_of_neg_of_pos (Ha : a < 0) (Hb : 0 < b) : a / b < 0:=
begin
rewrite div_eq_mul_one_div,
apply mul_neg_of_neg_of_pos,
exact Ha,
apply one_div_pos_of_pos,
exact Hb
end
theorem div_nonpos_of_nonpos_of_pos (Ha : a ≤ 0) (Hb : 0 < b) : a / b ≤ 0 :=
begin
rewrite div_eq_mul_one_div,
apply mul_nonpos_of_nonpos_of_nonneg,
exact Ha,
apply le_of_lt,
apply one_div_pos_of_pos,
exact Hb
end
theorem div_neg_of_pos_of_neg (Ha : 0 < a) (Hb : b < 0) : a / b < 0 :=
begin
rewrite div_eq_mul_one_div,
apply mul_neg_of_pos_of_neg,
exact Ha,
apply one_div_neg_of_neg,
exact Hb
end
theorem div_nonpos_of_nonneg_of_neg (Ha : 0 ≤ a) (Hb : b < 0) : a / b ≤ 0 :=
begin
rewrite div_eq_mul_one_div,
apply mul_nonpos_of_nonneg_of_nonpos,
exact Ha,
apply le_of_lt,
apply one_div_neg_of_neg,
exact Hb
end
theorem div_pos_of_neg_of_neg (Ha : a < 0) (Hb : b < 0) : 0 < a / b :=
begin
rewrite div_eq_mul_one_div,
apply mul_pos_of_neg_of_neg,
exact Ha,
apply one_div_neg_of_neg,
exact Hb
end
theorem div_nonneg_of_nonpos_of_neg (Ha : a ≤ 0) (Hb : b < 0) : 0 ≤ a / b :=
begin
rewrite div_eq_mul_one_div,
apply mul_nonneg_of_nonpos_of_nonpos,
exact Ha,
apply le_of_lt,
apply one_div_neg_of_neg,
exact Hb
end
theorem div_lt_div_of_lt_of_pos (H : a < b) (Hc : 0 < c) : a / c < b / c :=
begin
rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div],
exact mul_lt_mul_of_pos_right H (one_div_pos_of_pos Hc)
end
theorem div_le_div_of_le_of_pos (H : a ≤ b) (Hc : 0 < c) : a / c ≤ b / c :=
begin
rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div],
exact mul_le_mul_of_nonneg_right H (le_of_lt (one_div_pos_of_pos Hc))
end
theorem div_lt_div_of_lt_of_neg (H : b < a) (Hc : c < 0) : a / c < b / c :=
begin
rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div],
exact mul_lt_mul_of_neg_right H (one_div_neg_of_neg Hc)
end
theorem div_le_div_of_le_of_neg (H : b ≤ a) (Hc : c < 0) : a / c ≤ b / c :=
begin
rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div],
exact mul_le_mul_of_nonpos_right H (le_of_lt (one_div_neg_of_neg Hc))
end
theorem two_pos : (1 : A) + 1 > 0 :=
add_pos zero_lt_one zero_lt_one
theorem one_add_one_ne_zero : 1 + 1 ≠ (0:A) :=
ne.symm (ne_of_lt two_pos)
theorem two_ne_zero : 2 ≠ (0:A) :=
by unfold bit0; apply one_add_one_ne_zero
theorem add_halves (a : A) : a / 2 + a / 2 = a :=
calc
a / 2 + a / 2 = (a + a) / 2 : by rewrite div_add_div_same
... = (a * 1 + a * 1) / 2 : by rewrite mul_one
... = (a * (1 + 1)) / 2 : by rewrite left_distrib
... = (a * 2) / 2 : by rewrite one_add_one_eq_two
... = a : by rewrite [@mul_div_cancel A _ _ _ two_ne_zero]
theorem sub_self_div_two (a : A) : a - a / 2 = a / 2 :=
by rewrite [-{a}add_halves at {1}, add_sub_cancel]
theorem add_midpoint {a b : A} (H : a < b) : a + (b - a) / 2 < b :=
begin
rewrite [-div_sub_div_same, sub_eq_add_neg, {b / 2 + _}add.comm, -add.assoc, -sub_eq_add_neg],
apply add_lt_of_lt_sub_right,
rewrite *sub_self_div_two,
apply div_lt_div_of_lt_of_pos H two_pos
end
theorem div_two_sub_self (a : A) : a / 2 - a = - (a / 2) :=
by rewrite [-{a}add_halves at {2}, sub_add_eq_sub_sub, sub_self, zero_sub]
theorem add_self_div_two (a : A) : (a + a) / 2 = a :=
symm (iff.mpr (!eq_div_iff_mul_eq (ne_of_gt (add_pos zero_lt_one zero_lt_one)))
(by krewrite [left_distrib, *mul_one]))
theorem two_ge_one : (2:A) ≥ 1 :=
calc (2:A) = 1+1 : one_add_one_eq_two
... ≥ 1+0 : add_le_add_left (le_of_lt zero_lt_one)
... = 1 : add_zero
theorem mul_le_mul_of_mul_div_le (H : a * (b / c) ≤ d) (Hc : c > 0) : b * a ≤ d * c :=
begin
rewrite [-mul_div_assoc at H, mul.comm b],
apply le_mul_of_div_le Hc H
end
theorem div_two_lt_of_pos (H : a > 0) : a / (1 + 1) < a :=
have Ha : a / (1 + 1) > 0, from div_pos_of_pos_of_pos H (add_pos zero_lt_one zero_lt_one),
calc
a / (1 + 1) < a / (1 + 1) + a / (1 + 1) : lt_add_of_pos_left Ha
... = a : add_halves
theorem div_mul_le_div_mul_of_div_le_div_pos {e : A} (Hb : b ≠ 0) (Hd : d ≠ 0) (H : a / b ≤ c / d)
(He : e > 0) : a / (b * e) ≤ c / (d * e) :=
begin
rewrite [!field.div_mul_eq_div_mul_one_div Hb (ne_of_gt He),
!field.div_mul_eq_div_mul_one_div Hd (ne_of_gt He)],
apply mul_le_mul_of_nonneg_right H,
apply le_of_lt,
apply one_div_pos_of_pos He
end
theorem exists_add_lt_and_pos_of_lt (H : b < a) : Σ c : A, b + c < a × c > 0 :=
sigma.mk ((a - b) / (1 + 1))
(pair (assert H2 : a + a > (b + b) + (a - b), from calc
a + a > b + a : add_lt_add_right H
... = b + a + b - b : add_sub_cancel
... = b + b + a - b : add.right_comm
... = (b + b) + (a - b) : add_sub,
assert H3 : (a + a) / 2 > ((b + b) + (a - b)) / 2,
from div_lt_div_of_lt_of_pos H2 two_pos,
by rewrite [one_add_one_eq_two, sub_eq_add_neg, add_self_div_two at H3, -div_add_div_same at H3, add_self_div_two at H3];
exact H3)
(div_pos_of_pos_of_pos (iff.mpr !sub_pos_iff_lt H) two_pos))
theorem ge_of_forall_ge_sub {a b : A} (H : Π ε : A, ε > 0 → a ≥ b - ε) : a ≥ b :=
begin
apply le_of_not_gt,
intro Hb,
cases exists_add_lt_and_pos_of_lt Hb with [c, Hc],
let Hc' := H c (prod.pr2 Hc),
apply (not_le_of_gt (prod.pr1 Hc)) (iff.mpr !le_add_iff_sub_right_le Hc')
end
end linear_ordered_field
structure discrete_linear_ordered_field [class] (A : Type) extends linear_ordered_field A,
decidable_linear_ordered_comm_ring A :=
(inv_zero : inv zero = zero)
section discrete_linear_ordered_field
variable {A : Type}
variables [s : discrete_linear_ordered_field A] {a b c : A}
include s
definition dec_eq_of_dec_lt : Π x y : A, decidable (x = y) :=
take x y,
decidable.by_cases
(assume H : x < y, decidable.inr (ne_of_lt H))
(assume H : ¬ x < y,
decidable.by_cases
(assume H' : y < x, decidable.inr (ne.symm (ne_of_lt H')))
(assume H' : ¬ y < x,
decidable.inl (le.antisymm (le_of_not_gt H') (le_of_not_gt H))))
definition discrete_linear_ordered_field.to_discrete_field [trans_instance] [reducible]
: discrete_field A :=
⦃ discrete_field, s, has_decidable_eq := dec_eq_of_dec_lt⦄
theorem pos_of_one_div_pos (H : 0 < 1 / a) : 0 < a :=
have H1 : 0 < 1 / (1 / a), from one_div_pos_of_pos H,
have H2 : 1 / a ≠ 0, from
(assume H3 : 1 / a = 0,
have H4 : 1 / (1 / a) = 0, from H3⁻¹ ▸ !div_zero,
absurd H4 (ne.symm (ne_of_lt H1))),
(division_ring.one_div_one_div (ne_zero_of_one_div_ne_zero H2)) ▸ H1
theorem neg_of_one_div_neg (H : 1 / a < 0) : a < 0 :=
have H1 : 0 < - (1 / a), from neg_pos_of_neg H,
have Ha : a ≠ 0, from ne_zero_of_one_div_ne_zero (ne_of_lt H),
have H2 : 0 < 1 / (-a), from (division_ring.one_div_neg_eq_neg_one_div Ha)⁻¹ ▸ H1,
have H3 : 0 < -a, from pos_of_one_div_pos H2,
neg_of_neg_pos H3
theorem le_of_one_div_le_one_div (H : 0 < a) (Hl : 1 / a ≤ 1 / b) : b ≤ a :=
have Hb : 0 < b, from pos_of_one_div_pos (calc
0 < 1 / a : one_div_pos_of_pos H
... ≤ 1 / b : Hl),
have H' : 1 ≤ a / b, from (calc
1 = a / a : div_self (ne.symm (ne_of_lt H))
... = a * (1 / a) : div_eq_mul_one_div
... ≤ a * (1 / b) : mul_le_mul_of_nonneg_left Hl (le_of_lt H)
... = a / b : div_eq_mul_one_div
), le_of_one_le_div Hb H'
theorem le_of_one_div_le_one_div_of_neg (H : b < 0) (Hl : 1 / a ≤ 1 / b) : b ≤ a :=
assert Ha : a ≠ 0, from ne_of_lt (neg_of_one_div_neg (calc
1 / a ≤ 1 / b : Hl
... < 0 : one_div_neg_of_neg H)),
have H' : -b > 0, from neg_pos_of_neg H,
have Hl' : - (1 / b) ≤ - (1 / a), from neg_le_neg Hl,
have Hl'' : 1 / - b ≤ 1 / - a, from calc
1 / -b = - (1 / b) : by rewrite [division_ring.one_div_neg_eq_neg_one_div (ne_of_lt H)]
... ≤ - (1 / a) : Hl'
... = 1 / -a : by rewrite [division_ring.one_div_neg_eq_neg_one_div Ha],
le_of_neg_le_neg (le_of_one_div_le_one_div H' Hl'')
theorem lt_of_one_div_lt_one_div (H : 0 < a) (Hl : 1 / a < 1 / b) : b < a :=
have Hb : 0 < b, from pos_of_one_div_pos (calc
0 < 1 / a : one_div_pos_of_pos H
... < 1 / b : Hl),
have H : 1 < a / b, from (calc
1 = a / a : div_self (ne.symm (ne_of_lt H))
... = a * (1 / a) : div_eq_mul_one_div
... < a * (1 / b) : mul_lt_mul_of_pos_left Hl H
... = a / b : div_eq_mul_one_div),
lt_of_one_lt_div Hb H
theorem lt_of_one_div_lt_one_div_of_neg (H : b < 0) (Hl : 1 / a < 1 / b) : b < a :=
have H1 : b ≤ a, from le_of_one_div_le_one_div_of_neg H (le_of_lt Hl),
have Hn : b ≠ a, from
(assume Hn' : b = a,
have Hl' : 1 / a = 1 / b, from Hn' ▸ refl _,
absurd Hl' (ne_of_lt Hl)),
lt_of_le_of_ne H1 Hn
theorem one_div_lt_one_div_of_lt (Ha : 0 < a) (H : a < b) : 1 / b < 1 / a :=
lt_of_not_ge
(assume H',
absurd H (not_lt_of_ge (le_of_one_div_le_one_div Ha H')))
theorem one_div_le_one_div_of_le (Ha : 0 < a) (H : a ≤ b) : 1 / b ≤ 1 / a :=
le_of_not_gt
(assume H',
absurd H (not_le_of_gt (lt_of_one_div_lt_one_div Ha H')))
theorem one_div_lt_one_div_of_lt_of_neg (Hb : b < 0) (H : a < b) : 1 / b < 1 / a :=
lt_of_not_ge
(assume H',
absurd H (not_lt_of_ge (le_of_one_div_le_one_div_of_neg Hb H')))
theorem one_div_le_one_div_of_le_of_neg (Hb : b < 0) (H : a ≤ b) : 1 / b ≤ 1 / a :=
le_of_not_gt
(assume H',
absurd H (not_le_of_gt (lt_of_one_div_lt_one_div_of_neg Hb H')))
theorem one_lt_one_div (H1 : 0 < a) (H2 : a < 1) : 1 < 1 / a :=
one_div_one ▸ one_div_lt_one_div_of_lt H1 H2
theorem one_le_one_div (H1 : 0 < a) (H2 : a ≤ 1) : 1 ≤ 1 / a :=
one_div_one ▸ one_div_le_one_div_of_le H1 H2
theorem one_div_lt_neg_one (H1 : a < 0) (H2 : -1 < a) : 1 / a < -1 :=
one_div_neg_one_eq_neg_one ▸ one_div_lt_one_div_of_lt_of_neg H1 H2
theorem one_div_le_neg_one (H1 : a < 0) (H2 : -1 ≤ a) : 1 / a ≤ -1 :=
one_div_neg_one_eq_neg_one ▸ one_div_le_one_div_of_le_of_neg H1 H2
theorem div_lt_div_of_pos_of_lt_of_pos (Hb : 0 < b) (H : b < a) (Hc : 0 < c) : c / a < c / b :=
begin
apply iff.mp !sub_neg_iff_lt,
rewrite [div_eq_mul_one_div, {c / b}div_eq_mul_one_div, -mul_sub_left_distrib],
apply mul_neg_of_pos_of_neg,
exact Hc,
apply iff.mpr !sub_neg_iff_lt,
apply one_div_lt_one_div_of_lt,
repeat assumption
end
theorem div_mul_le_div_mul_of_div_le_div_pos' {d e : A} (H : a / b ≤ c / d)
(He : e > 0) : a / (b * e) ≤ c / (d * e) :=
begin
rewrite [2 div_mul_eq_div_mul_one_div],
apply mul_le_mul_of_nonneg_right H,
apply le_of_lt,
apply one_div_pos_of_pos He
end
theorem abs_one_div (a : A) : abs (1 / a) = 1 / abs a :=
if H : a > 0 then
by rewrite [abs_of_pos H, abs_of_pos (one_div_pos_of_pos H)]
else
(if H' : a < 0 then
by rewrite [abs_of_neg H', abs_of_neg (one_div_neg_of_neg H'),
-(division_ring.one_div_neg_eq_neg_one_div (ne_of_lt H'))]
else
assert Heq : a = 0, from eq_of_le_of_ge (le_of_not_gt H) (le_of_not_gt H'),
by rewrite [Heq, div_zero, *abs_zero, div_zero])
theorem sign_eq_div_abs (a : A) : sign a = a / (abs a) :=
decidable.by_cases
(suppose a = 0, by subst a; rewrite [zero_div, sign_zero])
(suppose a ≠ 0,
have abs a ≠ 0, from assume H, this (eq_zero_of_abs_eq_zero H),
!eq_div_of_mul_eq this !eq_sign_mul_abs⁻¹)
end discrete_linear_ordered_field
end algebra

658
hott/algebra/ordered_group.hlean
View file

@ -3,135 +3,126 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
Partially ordered additive groups, modeled on Isabelle's library. We could refine the structures,
but we would have to declare more inheritance paths.
Ported from the standard library
Partially ordered additive groups, modeled on Isabelle's library. These classes can be refined
if necessary.
-/
import .order .group
open core
namespace algebra
import algebra.binary algebra.group algebra.order
open eq eq.ops algebra -- note: ⁻¹ will be overloaded
set_option class.force_new true
variable {A : Type}
/- partially ordered monoids, such as the natural numbers -/
namespace algebra
structure ordered_cancel_comm_monoid [class] (A : Type) extends add_comm_monoid A,
add_left_cancel_semigroup A, add_right_cancel_semigroup A, order_pair A :=
(add_le_add_left : Πa b, le a b → Πc, le (add c a) (add c b))
(le_of_add_le_add_left : Πa b c, le (add a b) (add a c) → le b c)
(add_lt_add_left : Πa b, lt a b → Πc, lt (add c a) (add c b))
(lt_of_add_lt_add_left : Πa b c, lt (add a b) (add a c) → lt b c)
section
variables [s : ordered_cancel_comm_monoid A]
variables {a b c d e : A}
include s
definition add_le_add_left (H : a ≤ b) (c : A) : c + a ≤ c + b :=
!ordered_cancel_comm_monoid.add_le_add_left H c
theorem add_lt_add_left (H : a < b) (c : A) : c + a < c + b :=
!ordered_cancel_comm_monoid.add_lt_add_left H c
definition add_le_add_right (H : a ≤ b) (c : A) : a + c ≤ b + c :=
(add.comm c a) ▸ (add.comm c b) ▸ (add_le_add_left H c)
definition add_le_add (Hab : a ≤ b) (Hcd : c ≤ d) : a + c ≤ b + d :=
le.trans (add_le_add_right Hab c) (add_le_add_left Hcd b)
definition add_lt_add_left (H : a < b) (c : A) : c + a < c + b :=
have H1 : c + a ≤ c + b, from add_le_add_left (le_of_lt H) c,
have H2 : c + a ≠ c + b, from
take H3 : c + a = c + b,
have H4 : a = b, from add.left_cancel H3,
ne_of_lt H H4,
lt_of_le_of_ne H1 H2
definition add_lt_add_right (H : a < b) (c : A) : a + c < b + c :=
theorem add_lt_add_right (H : a < b) (c : A) : a + c < b + c :=
begin
rewrite [add.comm, {b + _}add.comm],
exact (add_lt_add_left H c)
end
definition le_add_of_nonneg_right (H : b ≥ 0) : a ≤ a + b :=
theorem add_le_add_left (H : a ≤ b) (c : A) : c + a ≤ c + b :=
!ordered_cancel_comm_monoid.add_le_add_left H c
theorem add_le_add_right (H : a ≤ b) (c : A) : a + c ≤ b + c :=
(add.comm c a) ▸ (add.comm c b) ▸ (add_le_add_left H c)
theorem add_le_add (Hab : a ≤ b) (Hcd : c ≤ d) : a + c ≤ b + d :=
le.trans (add_le_add_right Hab c) (add_le_add_left Hcd b)
theorem le_add_of_nonneg_right (H : b ≥ 0) : a ≤ a + b :=
begin
have H1 : a + b ≥ a + 0, from add_le_add_left H a,
rewrite add_zero at H1,
exact H1
end
definition le_add_of_nonneg_left (H : b ≥ 0) : a ≤ b + a :=
theorem le_add_of_nonneg_left (H : b ≥ 0) : a ≤ b + a :=
begin
have H1 : 0 + a ≤ b + a, from add_le_add_right H a,
rewrite zero_add at H1,
exact H1
end
definition add_lt_add (Hab : a < b) (Hcd : c < d) : a + c < b + d :=
theorem add_lt_add (Hab : a < b) (Hcd : c < d) : a + c < b + d :=
lt.trans (add_lt_add_right Hab c) (add_lt_add_left Hcd b)
definition add_lt_add_of_le_of_lt (Hab : a ≤ b) (Hcd : c < d) : a + c < b + d :=
theorem add_lt_add_of_le_of_lt (Hab : a ≤ b) (Hcd : c < d) : a + c < b + d :=
lt_of_le_of_lt (add_le_add_right Hab c) (add_lt_add_left Hcd b)
definition add_lt_add_of_lt_of_le (Hab : a < b) (Hcd : c ≤ d) : a + c < b + d :=
theorem add_lt_add_of_lt_of_le (Hab : a < b) (Hcd : c ≤ d) : a + c < b + d :=
lt_of_lt_of_le (add_lt_add_right Hab c) (add_le_add_left Hcd b)
definition lt_add_of_pos_right (H : b > 0) : a < a + b := !add_zero ▸ add_lt_add_left H a
theorem lt_add_of_pos_right (H : b > 0) : a < a + b := !add_zero ▸ add_lt_add_left H a
definition lt_add_of_pos_left (H : b > 0) : a < b + a := !zero_add ▸ add_lt_add_right H a
theorem lt_add_of_pos_left (H : b > 0) : a < b + a := !zero_add ▸ add_lt_add_right H a
-- here we start using le_of_add_le_add_left.
definition le_of_add_le_add_left (H : a + b ≤ a + c) : b ≤ c :=
theorem le_of_add_le_add_left (H : a + b ≤ a + c) : b ≤ c :=
!ordered_cancel_comm_monoid.le_of_add_le_add_left H
definition le_of_add_le_add_right (H : a + b ≤ c + b) : a ≤ c :=
theorem le_of_add_le_add_right (H : a + b ≤ c + b) : a ≤ c :=
le_of_add_le_add_left (show b + a ≤ b + c, begin rewrite [add.comm, {b + _}add.comm], exact H end)
definition lt_of_add_lt_add_left (H : a + b < a + c) : b < c :=
have H1 : b ≤ c, from le_of_add_le_add_left (le_of_lt H),
have H2 : b ≠ c, from
assume H3 : b = c, lt.irrefl _ (H3 ▸ H),
lt_of_le_of_ne H1 H2
theorem lt_of_add_lt_add_left (H : a + b < a + c) : b < c :=
!ordered_cancel_comm_monoid.lt_of_add_lt_add_left H
definition lt_of_add_lt_add_right (H : a + b < c + b) : a < c :=
theorem lt_of_add_lt_add_right (H : a + b < c + b) : a < c :=
lt_of_add_lt_add_left ((add.comm a b) ▸ (add.comm c b) ▸ H)
definition add_le_add_left_iff (a b c : A) : a + b ≤ a + c ↔ b ≤ c :=
theorem add_le_add_left_iff (a b c : A) : a + b ≤ a + c ↔ b ≤ c :=
iff.intro le_of_add_le_add_left (assume H, add_le_add_left H _)
definition add_le_add_right_iff (a b c : A) : a + b ≤ c + b ↔ a ≤ c :=
theorem add_le_add_right_iff (a b c : A) : a + b ≤ c + b ↔ a ≤ c :=
iff.intro le_of_add_le_add_right (assume H, add_le_add_right H _)
definition add_lt_add_left_iff (a b c : A) : a + b < a + c ↔ b < c :=
theorem add_lt_add_left_iff (a b c : A) : a + b < a + c ↔ b < c :=
iff.intro lt_of_add_lt_add_left (assume H, add_lt_add_left H _)
definition add_lt_add_right_iff (a b c : A) : a + b < c + b ↔ a < c :=
theorem add_lt_add_right_iff (a b c : A) : a + b < c + b ↔ a < c :=
iff.intro lt_of_add_lt_add_right (assume H, add_lt_add_right H _)
-- here we start using properties of zero.
definition add_nonneg (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a + b :=
theorem add_nonneg (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a + b :=
!zero_add ▸ (add_le_add Ha Hb)
definition add_pos (Ha : 0 < a) (Hb : 0 < b) : 0 < a + b :=
theorem add_pos (Ha : 0 < a) (Hb : 0 < b) : 0 < a + b :=
!zero_add ▸ (add_lt_add Ha Hb)
definition add_pos_of_pos_of_nonneg (Ha : 0 < a) (Hb : 0 ≤ b) : 0 < a + b :=
theorem add_pos_of_pos_of_nonneg (Ha : 0 < a) (Hb : 0 ≤ b) : 0 < a + b :=
!zero_add ▸ (add_lt_add_of_lt_of_le Ha Hb)
definition add_pos_of_nonneg_of_pos (Ha : 0 ≤ a) (Hb : 0 < b) : 0 < a + b :=
theorem add_pos_of_nonneg_of_pos (Ha : 0 ≤ a) (Hb : 0 < b) : 0 < a + b :=
!zero_add ▸ (add_lt_add_of_le_of_lt Ha Hb)
definition add_nonpos (Ha : a ≤ 0) (Hb : b ≤ 0) : a + b ≤ 0 :=
theorem add_nonpos (Ha : a ≤ 0) (Hb : b ≤ 0) : a + b ≤ 0 :=
!zero_add ▸ (add_le_add Ha Hb)
definition add_neg (Ha : a < 0) (Hb : b < 0) : a + b < 0 :=
theorem add_neg (Ha : a < 0) (Hb : b < 0) : a + b < 0 :=
!zero_add ▸ (add_lt_add Ha Hb)
definition add_neg_of_neg_of_nonpos (Ha : a < 0) (Hb : b ≤ 0) : a + b < 0 :=
theorem add_neg_of_neg_of_nonpos (Ha : a < 0) (Hb : b ≤ 0) : a + b < 0 :=
!zero_add ▸ (add_lt_add_of_lt_of_le Ha Hb)
definition add_neg_of_nonpos_of_neg (Ha : a ≤ 0) (Hb : b < 0) : a + b < 0 :=
theorem add_neg_of_nonpos_of_neg (Ha : a ≤ 0) (Hb : b < 0) : a + b < 0 :=
!zero_add ▸ (add_lt_add_of_le_of_lt Ha Hb)
-- TODO: add nonpos version (will be easier with simplifier)
definition add_eq_zero_iff_eq_zero_and_eq_zero_of_nonneg_of_nonneg
theorem add_eq_zero_iff_eq_zero_and_eq_zero_of_nonneg_of_nonneg
(Ha : 0 ≤ a) (Hb : 0 ≤ b) : a + b = 0 ↔ a = 0 × b = 0 :=
iff.intro
(assume Hab : a + b = 0,
@ -144,267 +135,549 @@ section
have Hb' : b ≤ 0, from
calc
b = 0 + b : by rewrite zero_add
... ≤ a + b : add_le_add_right Ha
... ≤ a + b : by exact add_le_add_right Ha _
... = 0 : Hab,
have Hbz : b = 0, from le.antisymm Hb' Hb,
pair Haz Hbz)
(assume Hab : a = 0 × b = 0,
match Hab with
| pair Ha' Hb' := by rewrite [Ha', Hb', add_zero]
end)
obtain Ha' Hb', from Hab,
by rewrite [Ha', Hb', add_zero])
definition le_add_of_nonneg_of_le (Ha : 0 ≤ a) (Hbc : b ≤ c) : b ≤ a + c :=
theorem le_add_of_nonneg_of_le (Ha : 0 ≤ a) (Hbc : b ≤ c) : b ≤ a + c :=
!zero_add ▸ add_le_add Ha Hbc
definition le_add_of_le_of_nonneg (Hbc : b ≤ c) (Ha : 0 ≤ a) : b ≤ c + a :=
theorem le_add_of_le_of_nonneg (Hbc : b ≤ c) (Ha : 0 ≤ a) : b ≤ c + a :=
!add_zero ▸ add_le_add Hbc Ha
definition lt_add_of_pos_of_le (Ha : 0 < a) (Hbc : b ≤ c) : b < a + c :=
theorem lt_add_of_pos_of_le (Ha : 0 < a) (Hbc : b ≤ c) : b < a + c :=
!zero_add ▸ add_lt_add_of_lt_of_le Ha Hbc
definition lt_add_of_le_of_pos (Hbc : b ≤ c) (Ha : 0 < a) : b < c + a :=
theorem lt_add_of_le_of_pos (Hbc : b ≤ c) (Ha : 0 < a) : b < c + a :=
!add_zero ▸ add_lt_add_of_le_of_lt Hbc Ha
definition add_le_of_nonpos_of_le (Ha : a ≤ 0) (Hbc : b ≤ c) : a + b ≤ c :=
theorem add_le_of_nonpos_of_le (Ha : a ≤ 0) (Hbc : b ≤ c) : a + b ≤ c :=
!zero_add ▸ add_le_add Ha Hbc
definition add_le_of_le_of_nonpos (Hbc : b ≤ c) (Ha : a ≤ 0) : b + a ≤ c :=
theorem add_le_of_le_of_nonpos (Hbc : b ≤ c) (Ha : a ≤ 0) : b + a ≤ c :=
!add_zero ▸ add_le_add Hbc Ha
definition add_lt_of_neg_of_le (Ha : a < 0) (Hbc : b ≤ c) : a + b < c :=
theorem add_lt_of_neg_of_le (Ha : a < 0) (Hbc : b ≤ c) : a + b < c :=
!zero_add ▸ add_lt_add_of_lt_of_le Ha Hbc
definition add_lt_of_le_of_neg (Hbc : b ≤ c) (Ha : a < 0) : b + a < c :=
theorem add_lt_of_le_of_neg (Hbc : b ≤ c) (Ha : a < 0) : b + a < c :=
!add_zero ▸ add_lt_add_of_le_of_lt Hbc Ha
definition lt_add_of_nonneg_of_lt (Ha : 0 ≤ a) (Hbc : b < c) : b < a + c :=
theorem lt_add_of_nonneg_of_lt (Ha : 0 ≤ a) (Hbc : b < c) : b < a + c :=
!zero_add ▸ add_lt_add_of_le_of_lt Ha Hbc
definition lt_add_of_lt_of_nonneg (Hbc : b < c) (Ha : 0 ≤ a) : b < c + a :=
theorem lt_add_of_lt_of_nonneg (Hbc : b < c) (Ha : 0 ≤ a) : b < c + a :=
!add_zero ▸ add_lt_add_of_lt_of_le Hbc Ha
definition lt_add_of_pos_of_lt (Ha : 0 < a) (Hbc : b < c) : b < a + c :=
theorem lt_add_of_pos_of_lt (Ha : 0 < a) (Hbc : b < c) : b < a + c :=
!zero_add ▸ add_lt_add Ha Hbc
definition lt_add_of_lt_of_pos (Hbc : b < c) (Ha : 0 < a) : b < c + a :=
theorem lt_add_of_lt_of_pos (Hbc : b < c) (Ha : 0 < a) : b < c + a :=
!add_zero ▸ add_lt_add Hbc Ha
definition add_lt_of_nonpos_of_lt (Ha : a ≤ 0) (Hbc : b < c) : a + b < c :=
theorem add_lt_of_nonpos_of_lt (Ha : a ≤ 0) (Hbc : b < c) : a + b < c :=
!zero_add ▸ add_lt_add_of_le_of_lt Ha Hbc
definition add_lt_of_lt_of_nonpos (Hbc : b < c) (Ha : a ≤ 0) : b + a < c :=
theorem add_lt_of_lt_of_nonpos (Hbc : b < c) (Ha : a ≤ 0) : b + a < c :=
!add_zero ▸ add_lt_add_of_lt_of_le Hbc Ha
definition add_lt_of_neg_of_lt (Ha : a < 0) (Hbc : b < c) : a + b < c :=
theorem add_lt_of_neg_of_lt (Ha : a < 0) (Hbc : b < c) : a + b < c :=
!zero_add ▸ add_lt_add Ha Hbc
definition add_lt_of_lt_of_neg (Hbc : b < c) (Ha : a < 0) : b + a < c :=
theorem add_lt_of_lt_of_neg (Hbc : b < c) (Ha : a < 0) : b + a < c :=
!add_zero ▸ add_lt_add Hbc Ha
end
-- TODO: add properties of max and min
/- partially ordered groups -/
structure ordered_comm_group [class] (A : Type) extends add_comm_group A, order_pair A :=
(add_le_add_left : Πa b, le a b → Πc, le (add c a) (add c b))
(add_lt_add_left : Πa b, lt a b → Π c, lt (add c a) (add c b))
definition ordered_comm_group.le_of_add_le_add_left [s : ordered_comm_group A] {a b c : A} (H : a + b ≤ a + c) : b ≤ c :=
theorem ordered_comm_group.le_of_add_le_add_left [s : ordered_comm_group A] {a b c : A}
(H : a + b ≤ a + c) : b ≤ c :=
assert H' : -a + (a + b) ≤ -a + (a + c), from ordered_comm_group.add_le_add_left _ _ H _,
by rewrite *neg_add_cancel_left at H'; exact H'
definition ordered_comm_group.to_ordered_cancel_comm_monoid [instance] [reducible]
theorem ordered_comm_group.lt_of_add_lt_add_left [s : ordered_comm_group A] {a b c : A}
(H : a + b < a + c) : b < c :=
assert H' : -a + (a + b) < -a + (a + c), from ordered_comm_group.add_lt_add_left _ _ H _,
by rewrite *neg_add_cancel_left at H'; exact H'
definition ordered_comm_group.to_ordered_cancel_comm_monoid [trans_instance] [reducible]
[s : ordered_comm_group A] : ordered_cancel_comm_monoid A :=
⦃ ordered_cancel_comm_monoid, s,
add_left_cancel := @add.left_cancel A _,
add_right_cancel := @add.right_cancel A _,
le_of_add_le_add_left := @ordered_comm_group.le_of_add_le_add_left A _ ⦄
le_of_add_le_add_left := @ordered_comm_group.le_of_add_le_add_left A _,
lt_of_add_lt_add_left := @ordered_comm_group.lt_of_add_lt_add_left A _⦄
section
variables [s : ordered_comm_group A] (a b c d e : A)
include s
definition neg_le_neg {a b : A} (H : a ≤ b) : -b ≤ -a :=
theorem neg_le_neg {a b : A} (H : a ≤ b) : -b ≤ -a :=
have H1 : 0 ≤ -a + b, from !add.left_inv ▸ !(add_le_add_left H),
!add_neg_cancel_right ▸ !zero_add ▸ add_le_add_right H1 (-b)
definition le_of_neg_le_neg {a b : A} (H : -b ≤ -a) : a ≤ b :=
theorem le_of_neg_le_neg {a b : A} (H : -b ≤ -a) : a ≤ b :=
neg_neg a ▸ neg_neg b ▸ neg_le_neg H
definition neg_le_neg_iff_le : -a ≤ -b ↔ b ≤ a :=
theorem neg_le_neg_iff_le : -a ≤ -b ↔ b ≤ a :=
iff.intro le_of_neg_le_neg neg_le_neg
definition nonneg_of_neg_nonpos {a : A} (H : -a ≤ 0) : 0 ≤ a :=
theorem nonneg_of_neg_nonpos {a : A} (H : -a ≤ 0) : 0 ≤ a :=
le_of_neg_le_neg (neg_zero⁻¹ ▸ H)
definition neg_nonpos_of_nonneg {a : A} (H : 0 ≤ a) : -a ≤ 0 :=
theorem neg_nonpos_of_nonneg {a : A} (H : 0 ≤ a) : -a ≤ 0 :=
neg_zero ▸ neg_le_neg H
definition neg_nonpos_iff_nonneg : -a ≤ 0 ↔ 0 ≤ a :=
theorem neg_nonpos_iff_nonneg : -a ≤ 0 ↔ 0 ≤ a :=
iff.intro nonneg_of_neg_nonpos neg_nonpos_of_nonneg
definition nonpos_of_neg_nonneg {a : A} (H : 0 ≤ -a) : a ≤ 0 :=
theorem nonpos_of_neg_nonneg {a : A} (H : 0 ≤ -a) : a ≤ 0 :=
le_of_neg_le_neg (neg_zero⁻¹ ▸ H)
definition neg_nonneg_of_nonpos {a : A} (H : a ≤ 0) : 0 ≤ -a :=
theorem neg_nonneg_of_nonpos {a : A} (H : a ≤ 0) : 0 ≤ -a :=
neg_zero ▸ neg_le_neg H
definition neg_nonneg_iff_nonpos : 0 ≤ -a ↔ a ≤ 0 :=
theorem neg_nonneg_iff_nonpos : 0 ≤ -a ↔ a ≤ 0 :=
iff.intro nonpos_of_neg_nonneg neg_nonneg_of_nonpos
definition neg_lt_neg {a b : A} (H : a < b) : -b < -a :=
theorem neg_lt_neg {a b : A} (H : a < b) : -b < -a :=
have H1 : 0 < -a + b, from !add.left_inv ▸ !(add_lt_add_left H),
!add_neg_cancel_right ▸ !zero_add ▸ add_lt_add_right H1 (-b)
definition lt_of_neg_lt_neg {a b : A} (H : -b < -a) : a < b :=
theorem lt_of_neg_lt_neg {a b : A} (H : -b < -a) : a < b :=
neg_neg a ▸ neg_neg b ▸ neg_lt_neg H
definition neg_lt_neg_iff_lt : -a < -b ↔ b < a :=
theorem neg_lt_neg_iff_lt : -a < -b ↔ b < a :=
iff.intro lt_of_neg_lt_neg neg_lt_neg
definition pos_of_neg_neg {a : A} (H : -a < 0) : 0 < a :=
theorem pos_of_neg_neg {a : A} (H : -a < 0) : 0 < a :=
lt_of_neg_lt_neg (neg_zero⁻¹ ▸ H)
definition neg_neg_of_pos {a : A} (H : 0 < a) : -a < 0 :=
theorem neg_neg_of_pos {a : A} (H : 0 < a) : -a < 0 :=
neg_zero ▸ neg_lt_neg H
definition neg_neg_iff_pos : -a < 0 ↔ 0 < a :=
theorem neg_neg_iff_pos : -a < 0 ↔ 0 < a :=
iff.intro pos_of_neg_neg neg_neg_of_pos
definition neg_of_neg_pos {a : A} (H : 0 < -a) : a < 0 :=
theorem neg_of_neg_pos {a : A} (H : 0 < -a) : a < 0 :=
lt_of_neg_lt_neg (neg_zero⁻¹ ▸ H)
definition neg_pos_of_neg {a : A} (H : a < 0) : 0 < -a :=
theorem neg_pos_of_neg {a : A} (H : a < 0) : 0 < -a :=
neg_zero ▸ neg_lt_neg H
definition neg_pos_iff_neg : 0 < -a ↔ a < 0 :=
theorem neg_pos_iff_neg : 0 < -a ↔ a < 0 :=
iff.intro neg_of_neg_pos neg_pos_of_neg
definition le_neg_iff_le_neg : a ≤ -b ↔ b ≤ -a := !neg_neg ▸ !neg_le_neg_iff_le
theorem le_neg_iff_le_neg : a ≤ -b ↔ b ≤ -a := !neg_neg ▸ !neg_le_neg_iff_le
definition neg_le_iff_neg_le : -a ≤ b ↔ -b ≤ a := !neg_neg ▸ !neg_le_neg_iff_le
theorem le_neg_of_le_neg {a b : A} : a ≤ -b → b ≤ -a := iff.mp !le_neg_iff_le_neg
definition lt_neg_iff_lt_neg : a < -b ↔ b < -a := !neg_neg ▸ !neg_lt_neg_iff_lt
theorem neg_le_iff_neg_le : -a ≤ b ↔ -b ≤ a := !neg_neg ▸ !neg_le_neg_iff_le
definition neg_lt_iff_neg_lt : -a < b ↔ -b < a := !neg_neg ▸ !neg_lt_neg_iff_lt
theorem neg_le_of_neg_le {a b : A} : -a ≤ b → -b ≤ a := iff.mp !neg_le_iff_neg_le
definition sub_nonneg_iff_le : 0 ≤ a - b ↔ b ≤ a := !sub_self ▸ !add_le_add_right_iff
theorem lt_neg_iff_lt_neg : a < -b ↔ b < -a := !neg_neg ▸ !neg_lt_neg_iff_lt
definition sub_nonpos_iff_le : a - b ≤ 0 ↔ a ≤ b := !sub_self ▸ !add_le_add_right_iff
theorem lt_neg_of_lt_neg {a b : A} : a < -b → b < -a := iff.mp !lt_neg_iff_lt_neg
definition sub_pos_iff_lt : 0 < a - b ↔ b < a := !sub_self ▸ !add_lt_add_right_iff
theorem neg_lt_iff_neg_lt : -a < b ↔ -b < a := !neg_neg ▸ !neg_lt_neg_iff_lt
definition sub_neg_iff_lt : a - b < 0 ↔ a < b := !sub_self ▸ !add_lt_add_right_iff
theorem neg_lt_of_neg_lt {a b : A} : -a < b → -b < a := iff.mp !neg_lt_iff_neg_lt
definition add_le_iff_le_neg_add : a + b ≤ c ↔ b ≤ -a + c :=
theorem sub_nonneg_iff_le : 0 ≤ a - b ↔ b ≤ a := !sub_self ▸ !add_le_add_right_iff
theorem sub_nonneg_of_le {a b : A} : b ≤ a → 0 ≤ a - b := iff.mpr !sub_nonneg_iff_le
theorem le_of_sub_nonneg {a b : A} : 0 ≤ a - b → b ≤ a := iff.mp !sub_nonneg_iff_le
theorem sub_nonpos_iff_le : a - b ≤ 0 ↔ a ≤ b := !sub_self ▸ !add_le_add_right_iff
theorem sub_nonpos_of_le {a b : A} : a ≤ b → a - b ≤ 0 := iff.mpr !sub_nonpos_iff_le
theorem le_of_sub_nonpos {a b : A} : a - b ≤ 0 → a ≤ b := iff.mp !sub_nonpos_iff_le
theorem sub_pos_iff_lt : 0 < a - b ↔ b < a := !sub_self ▸ !add_lt_add_right_iff
theorem sub_pos_of_lt {a b : A} : b < a → 0 < a - b := iff.mpr !sub_pos_iff_lt
theorem lt_of_sub_pos {a b : A} : 0 < a - b → b < a := iff.mp !sub_pos_iff_lt
theorem sub_neg_iff_lt : a - b < 0 ↔ a < b := !sub_self ▸ !add_lt_add_right_iff
theorem sub_neg_of_lt {a b : A} : a < b → a - b < 0 := iff.mpr !sub_neg_iff_lt
theorem lt_of_sub_neg {a b : A} : a - b < 0 → a < b := iff.mp !sub_neg_iff_lt
theorem add_le_iff_le_neg_add : a + b ≤ c ↔ b ≤ -a + c :=
have H: a + b ≤ c ↔ -a + (a + b) ≤ -a + c, from iff.symm (!add_le_add_left_iff),
!neg_add_cancel_left ▸ H
definition add_le_iff_le_sub_left : a + b ≤ c ↔ b ≤ c - a :=
theorem add_le_of_le_neg_add {a b c : A} : b ≤ -a + c → a + b ≤ c :=
iff.mpr !add_le_iff_le_neg_add
theorem le_neg_add_of_add_le {a b c : A} : a + b ≤ c → b ≤ -a + c :=
iff.mp !add_le_iff_le_neg_add
theorem add_le_iff_le_sub_left : a + b ≤ c ↔ b ≤ c - a :=
by rewrite [sub_eq_add_neg, {c+_}add.comm]; apply add_le_iff_le_neg_add
definition add_le_iff_le_sub_right : a + b ≤ c ↔ a ≤ c - b :=
have H: a + b ≤ c ↔ a + b - b ≤ c - b, from iff.symm (!add_le_add_right_iff),
theorem add_le_of_le_sub_left {a b c : A} : b ≤ c - a → a + b ≤ c :=
iff.mpr !add_le_iff_le_sub_left
theorem le_sub_left_of_add_le {a b c : A} : a + b ≤ c → b ≤ c - a :=
iff.mp !add_le_iff_le_sub_left
theorem add_le_iff_le_sub_right : a + b ≤ c ↔ a ≤ c - b :=
have H: a + b ≤ c ↔ a + b - b ≤ c - b, from proof iff.symm (!add_le_add_right_iff) qed,
!add_neg_cancel_right ▸ H
definition le_add_iff_neg_add_le : a ≤ b + c ↔ -b + a ≤ c :=
theorem add_le_of_le_sub_right {a b c : A} : a ≤ c - b → a + b ≤ c :=
iff.mpr !add_le_iff_le_sub_right
theorem le_sub_right_of_add_le {a b c : A} : a + b ≤ c → a ≤ c - b :=
iff.mp !add_le_iff_le_sub_right
theorem le_add_iff_neg_add_le : a ≤ b + c ↔ -b + a ≤ c :=
assert H: a ≤ b + c ↔ -b + a ≤ -b + (b + c), from iff.symm (!add_le_add_left_iff),
by rewrite neg_add_cancel_left at H; exact H
definition le_add_iff_sub_left_le : a ≤ b + c ↔ a - b ≤ c :=
theorem le_add_of_neg_add_le {a b c : A} : -b + a ≤ c → a ≤ b + c :=
iff.mpr !le_add_iff_neg_add_le
theorem neg_add_le_of_le_add {a b c : A} : a ≤ b + c → -b + a ≤ c :=
iff.mp !le_add_iff_neg_add_le
theorem le_add_iff_sub_left_le : a ≤ b + c ↔ a - b ≤ c :=
by rewrite [sub_eq_add_neg, {a+_}add.comm]; apply le_add_iff_neg_add_le
definition le_add_iff_sub_right_le : a ≤ b + c ↔ a - c ≤ b :=
assert H: a ≤ b + c ↔ a - c ≤ b + c - c, from iff.symm (!add_le_add_right_iff),
by rewrite add_neg_cancel_right at H; exact H
theorem le_add_of_sub_left_le {a b c : A} : a - b ≤ c → a ≤ b + c :=
iff.mpr !le_add_iff_sub_left_le
definition add_lt_iff_lt_neg_add_left : a + b < c ↔ b < -a + c :=
theorem sub_left_le_of_le_add {a b c : A} : a ≤ b + c → a - b ≤ c :=
iff.mp !le_add_iff_sub_left_le
theorem le_add_iff_sub_right_le : a ≤ b + c ↔ a - c ≤ b :=
assert H: a ≤ b + c ↔ a - c ≤ b + c - c, from iff.symm (!add_le_add_right_iff),
by rewrite [sub_eq_add_neg (b+c) c at H, add_neg_cancel_right at H]; exact H
theorem le_add_of_sub_right_le {a b c : A} : a - c ≤ b → a ≤ b + c :=
iff.mpr !le_add_iff_sub_right_le
theorem sub_right_le_of_le_add {a b c : A} : a ≤ b + c → a - c ≤ b :=
iff.mp !le_add_iff_sub_right_le
theorem le_add_iff_neg_add_le_left : a ≤ b + c ↔ -b + a ≤ c :=
assert H: a ≤ b + c ↔ -b + a ≤ -b + (b + c), from iff.symm (!add_le_add_left_iff),
by rewrite neg_add_cancel_left at H; exact H
theorem le_add_of_neg_add_le_left {a b c : A} : -b + a ≤ c → a ≤ b + c :=
iff.mpr !le_add_iff_neg_add_le_left
theorem neg_add_le_left_of_le_add {a b c : A} : a ≤ b + c → -b + a ≤ c :=
iff.mp !le_add_iff_neg_add_le_left
theorem le_add_iff_neg_add_le_right : a ≤ b + c ↔ -c + a ≤ b :=
by rewrite add.comm; apply le_add_iff_neg_add_le_left
theorem le_add_of_neg_add_le_right {a b c : A} : -c + a ≤ b → a ≤ b + c :=
iff.mpr !le_add_iff_neg_add_le_right
theorem neg_add_le_right_of_le_add {a b c : A} : a ≤ b + c → -c + a ≤ b :=
iff.mp !le_add_iff_neg_add_le_right
theorem le_add_iff_neg_le_sub_left : c ≤ a + b ↔ -a ≤ b - c :=
assert H : c ≤ a + b ↔ -a + c ≤ b, from !le_add_iff_neg_add_le,
assert H' : -a + c ≤ b ↔ -a ≤ b - c, from !add_le_iff_le_sub_right,
iff.trans H H'
theorem le_add_of_neg_le_sub_left {a b c : A} : -a ≤ b - c → c ≤ a + b :=
iff.mpr !le_add_iff_neg_le_sub_left
theorem neg_le_sub_left_of_le_add {a b c : A} : c ≤ a + b → -a ≤ b - c :=
iff.mp !le_add_iff_neg_le_sub_left
theorem le_add_iff_neg_le_sub_right : c ≤ a + b ↔ -b ≤ a - c :=
by rewrite add.comm; apply le_add_iff_neg_le_sub_left
theorem le_add_of_neg_le_sub_right {a b c : A} : -b ≤ a - c → c ≤ a + b :=
iff.mpr !le_add_iff_neg_le_sub_right
theorem neg_le_sub_right_of_le_add {a b c : A} : c ≤ a + b → -b ≤ a - c :=
iff.mp !le_add_iff_neg_le_sub_right
theorem add_lt_iff_lt_neg_add_left : a + b < c ↔ b < -a + c :=
assert H: a + b < c ↔ -a + (a + b) < -a + c, from iff.symm (!add_lt_add_left_iff),
begin rewrite neg_add_cancel_left at H, exact H end
definition add_lt_iff_lt_neg_add_right : a + b < c ↔ a < -b + c :=
theorem add_lt_of_lt_neg_add_left {a b c : A} : b < -a + c → a + b < c :=
iff.mpr !add_lt_iff_lt_neg_add_left
theorem lt_neg_add_left_of_add_lt {a b c : A} : a + b < c → b < -a + c :=
iff.mp !add_lt_iff_lt_neg_add_left
theorem add_lt_iff_lt_neg_add_right : a + b < c ↔ a < -b + c :=
by rewrite add.comm; apply add_lt_iff_lt_neg_add_left
definition add_lt_iff_lt_sub_left : a + b < c ↔ b < c - a :=
theorem add_lt_of_lt_neg_add_right {a b c : A} : a < -b + c → a + b < c :=
iff.mpr !add_lt_iff_lt_neg_add_right
theorem lt_neg_add_right_of_add_lt {a b c : A} : a + b < c → a < -b + c :=
iff.mp !add_lt_iff_lt_neg_add_right
theorem add_lt_iff_lt_sub_left : a + b < c ↔ b < c - a :=
begin
rewrite [sub_eq_add_neg, {c+_}add.comm],
apply add_lt_iff_lt_neg_add_left
end
definition add_lt_add_iff_lt_sub_right : a + b < c ↔ a < c - b :=
assert H: a + b < c ↔ a + b - b < c - b, from iff.symm (!add_lt_add_right_iff),
by rewrite add_neg_cancel_right at H; exact H
theorem add_lt_of_lt_sub_left {a b c : A} : b < c - a → a + b < c :=
iff.mpr !add_lt_iff_lt_sub_left
definition lt_add_iff_neg_add_lt_left : a < b + c ↔ -b + a < c :=
theorem lt_sub_left_of_add_lt {a b c : A} : a + b < c → b < c - a :=
iff.mp !add_lt_iff_lt_sub_left
theorem add_lt_iff_lt_sub_right : a + b < c ↔ a < c - b :=
assert H: a + b < c ↔ a + b - b < c - b, from iff.symm (!add_lt_add_right_iff),
by rewrite [sub_eq_add_neg at H, add_neg_cancel_right at H]; exact H
theorem add_lt_of_lt_sub_right {a b c : A} : a < c - b → a + b < c :=
iff.mpr !add_lt_iff_lt_sub_right
theorem lt_sub_right_of_add_lt {a b c : A} : a + b < c → a < c - b :=
iff.mp !add_lt_iff_lt_sub_right
theorem lt_add_iff_neg_add_lt_left : a < b + c ↔ -b + a < c :=
assert H: a < b + c ↔ -b + a < -b + (b + c), from iff.symm (!add_lt_add_left_iff),
by rewrite neg_add_cancel_left at H; exact H
definition lt_add_iff_neg_add_lt_right : a < b + c ↔ -c + a < b :=
theorem lt_add_of_neg_add_lt_left {a b c : A} : -b + a < c → a < b + c :=
iff.mpr !lt_add_iff_neg_add_lt_left
theorem neg_add_lt_left_of_lt_add {a b c : A} : a < b + c → -b + a < c :=
iff.mp !lt_add_iff_neg_add_lt_left
theorem lt_add_iff_neg_add_lt_right : a < b + c ↔ -c + a < b :=
by rewrite add.comm; apply lt_add_iff_neg_add_lt_left
definition lt_add_iff_sub_lt_left : a < b + c ↔ a - b < c :=
theorem lt_add_of_neg_add_lt_right {a b c : A} : -c + a < b → a < b + c :=
iff.mpr !lt_add_iff_neg_add_lt_right
theorem neg_add_lt_right_of_lt_add {a b c : A} : a < b + c → -c + a < b :=
iff.mp !lt_add_iff_neg_add_lt_right
theorem lt_add_iff_sub_lt_left : a < b + c ↔ a - b < c :=
by rewrite [sub_eq_add_neg, {a + _}add.comm]; apply lt_add_iff_neg_add_lt_left
definition lt_add_iff_sub_lt_right : a < b + c ↔ a - c < b :=
theorem lt_add_of_sub_lt_left {a b c : A} : a - b < c → a < b + c :=
iff.mpr !lt_add_iff_sub_lt_left
theorem sub_lt_left_of_lt_add {a b c : A} : a < b + c → a - b < c :=
iff.mp !lt_add_iff_sub_lt_left
theorem lt_add_iff_sub_lt_right : a < b + c ↔ a - c < b :=
by rewrite add.comm; apply lt_add_iff_sub_lt_left
theorem lt_add_of_sub_lt_right {a b c : A} : a - c < b → a < b + c :=
iff.mpr !lt_add_iff_sub_lt_right
theorem sub_lt_right_of_lt_add {a b c : A} : a < b + c → a - c < b :=
iff.mp !lt_add_iff_sub_lt_right
theorem sub_lt_of_sub_lt {a b c : A} : a - b < c → a - c < b :=
begin
intro H,
apply sub_lt_left_of_lt_add,
apply lt_add_of_sub_lt_right H
end
theorem sub_le_of_sub_le {a b c : A} : a - b ≤ c → a - c ≤ b :=
begin
intro H,
apply sub_left_le_of_le_add,
apply le_add_of_sub_right_le H
end
-- TODO: the Isabelle library has varations on a + b ≤ b ↔ a ≤ 0
definition le_iff_le_of_sub_eq_sub {a b c d : A} (H : a - b = c - d) : a ≤ b ↔ c ≤ d :=
theorem le_iff_le_of_sub_eq_sub {a b c d : A} (H : a - b = c - d) : a ≤ b ↔ c ≤ d :=
calc
a ≤ b ↔ a - b ≤ 0 : iff.symm (sub_nonpos_iff_le a b)
... = (c - d ≤ 0) : by rewrite H
... ↔ c ≤ d : sub_nonpos_iff_le c d
definition lt_iff_lt_of_sub_eq_sub {a b c d : A} (H : a - b = c - d) : a < b ↔ c < d :=
theorem lt_iff_lt_of_sub_eq_sub {a b c d : A} (H : a - b = c - d) : a < b ↔ c < d :=
calc
a < b ↔ a - b < 0 : iff.symm (sub_neg_iff_lt a b)
... = (c - d < 0) : by rewrite H
... ↔ c < d : sub_neg_iff_lt c d
definition sub_le_sub_left {a b : A} (H : a ≤ b) (c : A) : c - b ≤ c - a :=
theorem sub_le_sub_left {a b : A} (H : a ≤ b) (c : A) : c - b ≤ c - a :=
add_le_add_left (neg_le_neg H) c
definition sub_le_sub_right {a b : A} (H : a ≤ b) (c : A) : a - c ≤ b - c := add_le_add_right H (-c)
theorem sub_le_sub_right {a b : A} (H : a ≤ b) (c : A) : a - c ≤ b - c := add_le_add_right H (-c)
definition sub_le_sub {a b c d : A} (Hab : a ≤ b) (Hcd : c ≤ d) : a - d ≤ b - c :=
theorem sub_le_sub {a b c d : A} (Hab : a ≤ b) (Hcd : c ≤ d) : a - d ≤ b - c :=
add_le_add Hab (neg_le_neg Hcd)
definition sub_lt_sub_left {a b : A} (H : a < b) (c : A) : c - b < c - a :=
theorem sub_lt_sub_left {a b : A} (H : a < b) (c : A) : c - b < c - a :=
add_lt_add_left (neg_lt_neg H) c
definition sub_lt_sub_right {a b : A} (H : a < b) (c : A) : a - c < b - c := add_lt_add_right H (-c)
theorem sub_lt_sub_right {a b : A} (H : a < b) (c : A) : a - c < b - c := add_lt_add_right H (-c)
definition sub_lt_sub {a b c d : A} (Hab : a < b) (Hcd : c < d) : a - d < b - c :=
theorem sub_lt_sub {a b c d : A} (Hab : a < b) (Hcd : c < d) : a - d < b - c :=
add_lt_add Hab (neg_lt_neg Hcd)
definition sub_lt_sub_of_le_of_lt {a b c d : A} (Hab : a ≤ b) (Hcd : c < d) : a - d < b - c :=
theorem sub_lt_sub_of_le_of_lt {a b c d : A} (Hab : a ≤ b) (Hcd : c < d) : a - d < b - c :=
add_lt_add_of_le_of_lt Hab (neg_lt_neg Hcd)
definition sub_lt_sub_of_lt_of_le {a b c d : A} (Hab : a < b) (Hcd : c ≤ d) : a - d < b - c :=
theorem sub_lt_sub_of_lt_of_le {a b c d : A} (Hab : a < b) (Hcd : c ≤ d) : a - d < b - c :=
add_lt_add_of_lt_of_le Hab (neg_le_neg Hcd)
definition sub_le_self (a : A) {b : A} (H : b ≥ 0) : a - b ≤ a :=
theorem sub_le_self (a : A) {b : A} (H : b ≥ 0) : a - b ≤ a :=
calc
a - b = a + -b : rfl
... ≤ a + 0 : add_le_add_left (neg_nonpos_of_nonneg H)
... = a : by rewrite add_zero
definition sub_lt_self (a : A) {b : A} (H : b > 0) : a - b < a :=
theorem sub_lt_self (a : A) {b : A} (H : b > 0) : a - b < a :=
calc
a - b = a + -b : rfl
... < a + 0 : add_lt_add_left (neg_neg_of_pos H)
... = a : by rewrite add_zero
theorem add_le_add_three {a b c d e f : A} (H1 : a ≤ d) (H2 : b ≤ e) (H3 : c ≤ f) :
a + b + c ≤ d + e + f :=
begin
apply le.trans,
apply add_le_add,
apply add_le_add,
repeat assumption,
apply le.refl
end
theorem sub_le_of_nonneg {b : A} (H : b ≥ 0) : a - b ≤ a :=
add_le_of_le_of_nonpos (le.refl a) (neg_nonpos_of_nonneg H)
theorem sub_lt_of_pos {b : A} (H : b > 0) : a - b < a :=
add_lt_of_le_of_neg (le.refl a) (neg_neg_of_pos H)
theorem neg_add_neg_le_neg_of_pos {a : A} (H : a > 0) : -a + -a ≤ -a :=
!neg_add ▸ neg_le_neg (le_add_of_nonneg_left (le_of_lt H))
end
/- linear ordered group with decidable order -/
structure decidable_linear_ordered_comm_group [class] (A : Type)
extends ordered_comm_group A, decidable_linear_order A
extends add_comm_group A, decidable_linear_order A :=
(add_le_add_left : Π a b, le a b → Π c, le (add c a) (add c b))
(add_lt_add_left : Π a b, lt a b → Π c, lt (add c a) (add c b))
definition decidable_linear_ordered_comm_group.to_ordered_comm_group
[trans_instance] [reducible]
(A : Type) [s : decidable_linear_ordered_comm_group A] : ordered_comm_group A :=
⦃ ordered_comm_group, s,
le_of_lt := @le_of_lt A _,
lt_of_le_of_lt := @lt_of_le_of_lt A _,
lt_of_lt_of_le := @lt_of_lt_of_le A _ ⦄
section
variables [s : decidable_linear_ordered_comm_group A]
variables {a b c d e : A}
include s
definition eq_zero_of_neg_eq (H : -a = a) : a = 0 :=
/- these can be generalized to a lattice ordered group -/
theorem min_add_add_left : min (a + b) (a + c) = a + min b c :=
inverse (eq_min
(show a + min b c ≤ a + b, from add_le_add_left !min_le_left _)
(show a + min b c ≤ a + c, from add_le_add_left !min_le_right _)
(take d,
assume H₁ : d ≤ a + b,
assume H₂ : d ≤ a + c,
have H : d - a ≤ min b c,
from le_min (iff.mp !le_add_iff_sub_left_le H₁) (iff.mp !le_add_iff_sub_left_le H₂),
show d ≤ a + min b c, from iff.mpr !le_add_iff_sub_left_le H))
theorem min_add_add_right : min (a + c) (b + c) = min a b + c :=
by rewrite [add.comm a c, add.comm b c, add.comm _ c]; apply min_add_add_left
theorem max_add_add_left : max (a + b) (a + c) = a + max b c :=
inverse (eq_max
(add_le_add_left !le_max_left _)
(add_le_add_left !le_max_right _)
(λ d H₁ H₂,
have H : max b c ≤ d - a,
from max_le (iff.mp !add_le_iff_le_sub_left H₁) (iff.mp !add_le_iff_le_sub_left H₂),
show a + max b c ≤ d, from iff.mpr !add_le_iff_le_sub_left H))
theorem max_add_add_right : max (a + c) (b + c) = max a b + c :=
by rewrite [add.comm a c, add.comm b c, add.comm _ c]; apply max_add_add_left
theorem max_neg_neg : max (-a) (-b) = - min a b :=
inverse (eq_max
(show -a ≤ -(min a b), from neg_le_neg !min_le_left)
(show -b ≤ -(min a b), from neg_le_neg !min_le_right)
(take d,
assume H₁ : -a ≤ d,
assume H₂ : -b ≤ d,
have H : -d ≤ min a b,
from le_min (!iff.mp !neg_le_iff_neg_le H₁) (!iff.mp !neg_le_iff_neg_le H₂),
show -(min a b) ≤ d, from !iff.mp !neg_le_iff_neg_le H))
theorem min_eq_neg_max_neg_neg : min a b = - max (-a) (-b) :=
by rewrite [max_neg_neg, neg_neg]
theorem min_neg_neg : min (-a) (-b) = - max a b :=
by rewrite [min_eq_neg_max_neg_neg, *neg_neg]
theorem max_eq_neg_min_neg_neg : max a b = - min (-a) (-b) :=
by rewrite [min_neg_neg, neg_neg]
/- absolute value -/
variables {a b c}
definition abs (a : A) : A := max a (-a)
theorem abs_of_nonneg (H : a ≥ 0) : abs a = a :=
have H' : -a ≤ a, from le.trans (neg_nonpos_of_nonneg H) H,
max_eq_left H'
theorem abs_of_pos (H : a > 0) : abs a = a :=
abs_of_nonneg (le_of_lt H)
theorem abs_of_nonpos (H : a ≤ 0) : abs a = -a :=
have H' : a ≤ -a, from le.trans H (neg_nonneg_of_nonpos H),
max_eq_right H'
theorem abs_of_neg (H : a < 0) : abs a = -a := abs_of_nonpos (le_of_lt H)
theorem abs_zero : abs 0 = (0:A) := abs_of_nonneg (le.refl _)
theorem abs_neg (a : A) : abs (-a) = abs a :=
by rewrite [↑abs, max.comm, neg_neg]
theorem abs_pos_of_pos (H : a > 0) : abs a > 0 :=
by rewrite (abs_of_pos H); exact H
theorem abs_pos_of_neg (H : a < 0) : abs a > 0 :=
!abs_neg ▸ abs_pos_of_pos (neg_pos_of_neg H)
theorem abs_sub (a b : A) : abs (a - b) = abs (b - a) :=
by rewrite [-neg_sub, abs_neg]
theorem ne_zero_of_abs_ne_zero {a : A} (H : abs a ≠ 0) : a ≠ 0 :=
assume Ha, H (Ha⁻¹ ▸ abs_zero)
/- these assume a linear order -/
theorem eq_zero_of_neg_eq (H : -a = a) : a = 0 :=
lt.by_cases
(assume H1 : a < 0,
have H2: a > 0, from H ▸ neg_pos_of_neg H1,
@ -414,75 +687,48 @@ section
have H2: a < 0, from H ▸ neg_neg_of_pos H1,
absurd H1 (lt.asymm H2))
definition abs (a : A) : A := if 0 ≤ a then a else -a
definition abs_of_nonneg (H : a ≥ 0) : abs a = a := if_pos H
definition abs_of_pos (H : a > 0) : abs a = a := if_pos (le_of_lt H)
definition abs_of_neg (H : a < 0) : abs a = -a := if_neg (not_le_of_lt H)
definition abs_zero : abs 0 = (0:A) := abs_of_nonneg (le.refl _)
definition abs_of_nonpos (H : a ≤ 0) : abs a = -a :=
decidable.by_cases
(assume H1 : a = 0, by rewrite [H1, abs_zero, neg_zero])
(assume H1 : a ≠ 0,
have H2 : a < 0, from lt_of_le_of_ne H H1,
abs_of_neg H2)
definition abs_neg (a : A) : abs (-a) = abs a :=
sum.rec_on (le.total 0 a)
(assume H1 : 0 ≤ a, by rewrite [abs_of_nonpos (neg_nonpos_of_nonneg H1), neg_neg, abs_of_nonneg H1])
(assume H1 : a ≤ 0, by rewrite [abs_of_nonneg (neg_nonneg_of_nonpos H1), abs_of_nonpos H1])
definition abs_nonneg (a : A) : abs a ≥ 0 :=
sum.rec_on (le.total 0 a)
theorem abs_nonneg (a : A) : abs a ≥ 0 :=
sum.elim (le.total 0 a)
(assume H : 0 ≤ a, by rewrite (abs_of_nonneg H); exact H)
(assume H : a ≤ 0,
calc
0 ≤ -a : neg_nonneg_of_nonpos H
... = abs a : abs_of_nonpos H)
definition abs_abs (a : A) : abs (abs a) = abs a := abs_of_nonneg !abs_nonneg
theorem abs_abs (a : A) : abs (abs a) = abs a := abs_of_nonneg !abs_nonneg
definition le_abs_self (a : A) : a ≤ abs a :=
sum.rec_on (le.total 0 a)
theorem le_abs_self (a : A) : a ≤ abs a :=
sum.elim (le.total 0 a)
(assume H : 0 ≤ a, abs_of_nonneg H ▸ !le.refl)
(assume H : a ≤ 0, le.trans H !abs_nonneg)
definition neg_le_abs_self (a : A) : -a ≤ abs a :=
theorem neg_le_abs_self (a : A) : -a ≤ abs a :=
!abs_neg ▸ !le_abs_self
definition eq_zero_of_abs_eq_zero (H : abs a = 0) : a = 0 :=
theorem eq_zero_of_abs_eq_zero (H : abs a = 0) : a = 0 :=
have H1 : a ≤ 0, from H ▸ le_abs_self a,
have H2 : -a ≤ 0, from H ▸ abs_neg a ▸ le_abs_self (-a),
le.antisymm H1 (nonneg_of_neg_nonpos H2)
definition abs_eq_zero_iff_eq_zero (a : A) : abs a = 0 ↔ a = 0 :=
theorem abs_eq_zero_iff_eq_zero (a : A) : abs a = 0 ↔ a = 0 :=
iff.intro eq_zero_of_abs_eq_zero (assume H, ap abs H ⬝ !abs_zero)
definition abs_pos_of_pos (H : a > 0) : abs a > 0 :=
by rewrite (abs_of_pos H); exact H
theorem eq_of_abs_sub_eq_zero {a b : A} (H : abs (a - b) = 0) : a = b :=
have a - b = 0, from eq_zero_of_abs_eq_zero H,
show a = b, from eq_of_sub_eq_zero this
definition abs_pos_of_neg (H : a < 0) : abs a > 0 :=
!abs_neg ▸ abs_pos_of_pos (neg_pos_of_neg H)
theorem abs_pos_of_ne_zero (H : a ≠ 0) : abs a > 0 :=
sum.elim (lt_or_gt_of_ne H) abs_pos_of_neg abs_pos_of_pos
definition abs_pos_of_ne_zero (H : a ≠ 0) : abs a > 0 :=
sum.rec_on (lt_or_gt_of_ne H) abs_pos_of_neg abs_pos_of_pos
definition abs_sub (a b : A) : abs (a - b) = abs (b - a) :=
by rewrite [-neg_sub, abs_neg]
definition abs.by_cases {P : A → Type} {a : A} (H1 : P a) (H2 : P (-a)) : P (abs a) :=
sum.rec_on (le.total 0 a)
theorem abs.by_cases {P : A → Type} {a : A} (H1 : P a) (H2 : P (-a)) : P (abs a) :=
sum.elim (le.total 0 a)
(assume H : 0 ≤ a, (abs_of_nonneg H)⁻¹ ▸ H1)
(assume H : a ≤ 0, (abs_of_nonpos H)⁻¹ ▸ H2)
definition abs_le_of_le_of_neg_le (H1 : a ≤ b) (H2 : -a ≤ b) : abs a ≤ b :=
theorem abs_le_of_le_of_neg_le (H1 : a ≤ b) (H2 : -a ≤ b) : abs a ≤ b :=
abs.by_cases H1 H2
definition abs_lt_of_lt_of_neg_lt (H1 : a < b) (H2 : -a < b) : abs a < b :=
theorem abs_lt_of_lt_of_neg_lt (H1 : a < b) (H2 : -a < b) : abs a < b :=
abs.by_cases H1 H2
-- the triangle inequality
@ -496,7 +742,7 @@ section
... = abs a + b : by rewrite (abs_of_nonneg H2)
... = abs a + abs b : by rewrite (abs_of_nonneg H3))
(assume H3 : ¬ b ≥ 0,
assert H4 : b ≤ 0, from le_of_lt (lt_of_not_le H3),
assert H4 : b ≤ 0, from le_of_lt (lt_of_not_ge H3),
calc
abs (a + b) = a + b : by rewrite (abs_of_nonneg H1)
... = abs a + b : by rewrite (abs_of_nonneg H2)
@ -505,13 +751,13 @@ section
... = abs a + abs b : by rewrite (abs_of_nonpos H4))
private lemma aux2 {a b : A} (H1 : a + b ≥ 0) : abs (a + b) ≤ abs a + abs b :=
sum.rec_on (le.total b 0)
sum.elim (le.total b 0)
(assume H2 : b ≤ 0,
have H3 : ¬ a < 0, from
assume H4 : a < 0,
have H5 : a + b < 0, from !add_zero ▸ add_lt_add_of_lt_of_le H4 H2,
not_lt_of_le H1 H5,
aux1 H1 (le_of_not_lt H3))
not_lt_of_ge H1 H5,
aux1 H1 (le_of_not_gt H3))
(assume H2 : 0 ≤ b,
begin
have H3 : abs (b + a) ≤ abs b + abs a,
@ -523,8 +769,8 @@ section
exact H3
end)
definition abs_add_le_abs_add_abs (a b : A) : abs (a + b) ≤ abs a + abs b :=
sum.rec_on (le.total 0 (a + b))
theorem abs_add_le_abs_add_abs (a b : A) : abs (a + b) ≤ abs a + abs b :=
sum.elim (le.total 0 (a + b))
(assume H2 : 0 ≤ a + b, aux2 H2)
(assume H2 : a + b ≤ 0,
assert H3 : -a + -b = -(a + b), by rewrite neg_add,
@ -534,15 +780,45 @@ section
abs (a + b) = abs (-a + -b) : by rewrite [-abs_neg, neg_add]
... ≤ abs (-a) + abs (-b) : aux2 H5
... = abs a + abs b : by rewrite *abs_neg)
end
definition abs_sub_abs_le_abs_sub (a b : A) : abs a - abs b ≤ abs (a - b) :=
theorem abs_sub_abs_le_abs_sub (a b : A) : abs a - abs b ≤ abs (a - b) :=
have H1 : abs a - abs b + abs b ≤ abs (a - b) + abs b, from
calc
abs a - abs b + abs b = abs a : by rewrite sub_add_cancel
... = abs (a - b + b) : by rewrite sub_add_cancel
... ≤ abs (a - b) + abs b : abs_add_le_abs_add_abs,
algebra.le_of_add_le_add_right H1
le_of_add_le_add_right H1
theorem abs_sub_le (a b c : A) : abs (a - c) ≤ abs (a - b) + abs (b - c) :=
calc
abs (a - c) = abs (a - b + (b - c)) : by rewrite [*sub_eq_add_neg, add.assoc, neg_add_cancel_left]
... ≤ abs (a - b) + abs (b - c) : abs_add_le_abs_add_abs
theorem abs_add_three (a b c : A) : abs (a + b + c) ≤ abs a + abs b + abs c :=
begin
apply le.trans,
apply abs_add_le_abs_add_abs,
apply le.trans,
apply add_le_add_right,
apply abs_add_le_abs_add_abs,
apply le.refl
end
theorem dist_bdd_within_interval {a b lb ub : A} (H : lb < ub) (Hal : lb ≤ a) (Hau : a ≤ ub)
(Hbl : lb ≤ b) (Hbu : b ≤ ub) : abs (a - b) ≤ ub - lb :=
begin
cases (decidable.em (b ≤ a)) with [Hba, Hba],
rewrite (abs_of_nonneg (iff.mpr !sub_nonneg_iff_le Hba)),
apply sub_le_sub,
apply Hau,
apply Hbl,
rewrite [abs_of_neg (iff.mpr !sub_neg_iff_lt (lt_of_not_ge Hba)), neg_sub],
apply sub_le_sub,
apply Hbu,
apply Hal
end
end
end
end algebra

329
hott/algebra/ordered_ring.hlean
View file

@ -6,23 +6,22 @@ Authors: Jeremy Avigad
Here an "ordered_ring" is partially ordered ring, which is ordered with respect to both a weak
order and an associated strict order. Our numeric structures (int, rat, and real) will be instances
of "linear_ordered_comm_ring". This development is modeled after Isabelle's library.
Ported from the standard library
-/
import algebra.ordered_group algebra.ring
open core
namespace algebra
open eq eq.ops
set_option class.force_new true
variable {A : Type}
definition absurd_a_lt_a {B : Type} {a : A} [s : strict_order A] (H : a < a) : B :=
namespace algebra
private definition absurd_a_lt_a {B : Type} {a : A} [s : strict_order A] (H : a < a) : B :=
absurd H (lt.irrefl a)
/- semiring structures -/
structure ordered_semiring [class] (A : Type)
extends has_mul A, has_zero A, has_lt A, -- TODO: remove hack for improving performance
semiring A, ordered_cancel_comm_monoid A, zero_ne_one_class A :=
extends semiring A, ordered_cancel_comm_monoid A :=
(mul_le_mul_of_nonneg_left: Πa b c, le a b → le zero c → le (mul c a) (mul c b))
(mul_le_mul_of_nonneg_right: Πa b c, le a b → le zero c → le (mul a c) (mul b c))
(mul_lt_mul_of_pos_left: Πa b c, lt a b → lt zero c → lt (mul c a) (mul c b))
@ -33,126 +32,174 @@ section
variables (a b c d e : A)
include s
definition mul_le_mul_of_nonneg_left {a b c : A} (Hab : a ≤ b) (Hc : 0 ≤ c) :
theorem mul_le_mul_of_nonneg_left {a b c : A} (Hab : a ≤ b) (Hc : 0 ≤ c) :
c * a ≤ c * b := !ordered_semiring.mul_le_mul_of_nonneg_left Hab Hc
definition mul_le_mul_of_nonneg_right {a b c : A} (Hab : a ≤ b) (Hc : 0 ≤ c) :
theorem mul_le_mul_of_nonneg_right {a b c : A} (Hab : a ≤ b) (Hc : 0 ≤ c) :
a * c ≤ b * c := !ordered_semiring.mul_le_mul_of_nonneg_right Hab Hc
-- TODO: there are four variations, depending on which variables we assume to be nonneg
definition mul_le_mul {a b c d : A} (Hac : a ≤ c) (Hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) :
theorem mul_le_mul {a b c d : A} (Hac : a ≤ c) (Hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) :
a * b ≤ c * d :=
calc
a * b ≤ c * b : mul_le_mul_of_nonneg_right Hac nn_b
... ≤ c * d : mul_le_mul_of_nonneg_left Hbd nn_c
definition mul_nonneg {a b : A} (Ha : a ≥ 0) (Hb : b ≥ 0) : a * b ≥ 0 :=
theorem mul_nonneg {a b : A} (Ha : a ≥ 0) (Hb : b ≥ 0) : a * b ≥ 0 :=
begin
have H : 0 * b ≤ a * b, from mul_le_mul_of_nonneg_right Ha Hb,
rewrite zero_mul at H,
exact H
end
definition mul_nonpos_of_nonneg_of_nonpos {a b : A} (Ha : a ≥ 0) (Hb : b ≤ 0) : a * b ≤ 0 :=
theorem mul_nonpos_of_nonneg_of_nonpos {a b : A} (Ha : a ≥ 0) (Hb : b ≤ 0) : a * b ≤ 0 :=
begin
have H : a * b ≤ a * 0, from mul_le_mul_of_nonneg_left Hb Ha,
rewrite mul_zero at H,
exact H
end
definition mul_nonpos_of_nonpos_of_nonneg {a b : A} (Ha : a ≤ 0) (Hb : b ≥ 0) : a * b ≤ 0 :=
theorem mul_nonpos_of_nonpos_of_nonneg {a b : A} (Ha : a ≤ 0) (Hb : b ≥ 0) : a * b ≤ 0 :=
begin
have H : a * b ≤ 0 * b, from mul_le_mul_of_nonneg_right Ha Hb,
rewrite zero_mul at H,
exact H
end
definition mul_lt_mul_of_pos_left {a b c : A} (Hab : a < b) (Hc : 0 < c) :
theorem mul_lt_mul_of_pos_left {a b c : A} (Hab : a < b) (Hc : 0 < c) :
c * a < c * b := !ordered_semiring.mul_lt_mul_of_pos_left Hab Hc
definition mul_lt_mul_of_pos_right {a b c : A} (Hab : a < b) (Hc : 0 < c) :
theorem mul_lt_mul_of_pos_right {a b c : A} (Hab : a < b) (Hc : 0 < c) :
a * c < b * c := !ordered_semiring.mul_lt_mul_of_pos_right Hab Hc
-- TODO: once again, there are variations
definition mul_lt_mul {a b c d : A} (Hac : a < c) (Hbd : b ≤ d) (pos_b : 0 < b) (nn_c : 0 ≤ c) :
theorem mul_lt_mul {a b c d : A} (Hac : a < c) (Hbd : b ≤ d) (pos_b : 0 < b) (nn_c : 0 ≤ c) :
a * b < c * d :=
calc
a * b < c * b : mul_lt_mul_of_pos_right Hac pos_b
... ≤ c * d : mul_le_mul_of_nonneg_left Hbd nn_c
definition mul_pos {a b : A} (Ha : a > 0) (Hb : b > 0) : a * b > 0 :=
theorem mul_pos {a b : A} (Ha : a > 0) (Hb : b > 0) : a * b > 0 :=
begin
have H : 0 * b < a * b, from mul_lt_mul_of_pos_right Ha Hb,
rewrite zero_mul at H,
exact H
end
definition mul_neg_of_pos_of_neg {a b : A} (Ha : a > 0) (Hb : b < 0) : a * b < 0 :=
theorem mul_neg_of_pos_of_neg {a b : A} (Ha : a > 0) (Hb : b < 0) : a * b < 0 :=
begin
have H : a * b < a * 0, from mul_lt_mul_of_pos_left Hb Ha,
rewrite mul_zero at H,
exact H
end
definition mul_neg_of_neg_of_pos {a b : A} (Ha : a < 0) (Hb : b > 0) : a * b < 0 :=
theorem mul_neg_of_neg_of_pos {a b : A} (Ha : a < 0) (Hb : b > 0) : a * b < 0 :=
begin
have H : a * b < 0 * b, from mul_lt_mul_of_pos_right Ha Hb,
rewrite zero_mul at H,
exact H
end
end
structure linear_ordered_semiring [class] (A : Type)
extends ordered_semiring A, linear_strong_order_pair A
extends ordered_semiring A, linear_strong_order_pair A :=
(zero_lt_one : lt zero one)
section
variable [s : linear_ordered_semiring A]
variables {a b c : A}
include s
definition lt_of_mul_lt_mul_left (H : c * a < c * b) (Hc : c ≥ 0) : a < b :=
lt_of_not_le
theorem zero_lt_one : 0 < (1:A) := linear_ordered_semiring.zero_lt_one A
theorem lt_of_mul_lt_mul_left (H : c * a < c * b) (Hc : c ≥ 0) : a < b :=
lt_of_not_ge
(assume H1 : b ≤ a,
have H2 : c * b ≤ c * a, from mul_le_mul_of_nonneg_left H1 Hc,
not_lt_of_le H2 H)
not_lt_of_ge H2 H)
definition lt_of_mul_lt_mul_right (H : a * c < b * c) (Hc : c ≥ 0) : a < b :=
lt_of_not_le
theorem lt_of_mul_lt_mul_right (H : a * c < b * c) (Hc : c ≥ 0) : a < b :=
lt_of_not_ge
(assume H1 : b ≤ a,
have H2 : b * c ≤ a * c, from mul_le_mul_of_nonneg_right H1 Hc,
not_lt_of_le H2 H)
not_lt_of_ge H2 H)
definition le_of_mul_le_mul_left (H : c * a ≤ c * b) (Hc : c > 0) : a ≤ b :=
le_of_not_lt
theorem le_of_mul_le_mul_left (H : c * a ≤ c * b) (Hc : c > 0) : a ≤ b :=
le_of_not_gt
(assume H1 : b < a,
have H2 : c * b < c * a, from mul_lt_mul_of_pos_left H1 Hc,
not_le_of_lt H2 H)
not_le_of_gt H2 H)
definition le_of_mul_le_mul_right (H : a * c ≤ b * c) (Hc : c > 0) : a ≤ b :=
le_of_not_lt
theorem le_of_mul_le_mul_right (H : a * c ≤ b * c) (Hc : c > 0) : a ≤ b :=
le_of_not_gt
(assume H1 : b < a,
have H2 : b * c < a * c, from mul_lt_mul_of_pos_right H1 Hc,
not_le_of_lt H2 H)
not_le_of_gt H2 H)
definition pos_of_mul_pos_left (H : 0 < a * b) (H1 : 0 ≤ a) : 0 < b :=
lt_of_not_le
theorem le_iff_mul_le_mul_left (a b : A) {c : A} (H : c > 0) : a ≤ b ↔ c * a ≤ c * b :=
iff.intro
(assume H', mul_le_mul_of_nonneg_left H' (le_of_lt H))
(assume H', le_of_mul_le_mul_left H' H)
theorem le_iff_mul_le_mul_right (a b : A) {c : A} (H : c > 0) : a ≤ b ↔ a * c ≤ b * c :=
iff.intro
(assume H', mul_le_mul_of_nonneg_right H' (le_of_lt H))
(assume H', le_of_mul_le_mul_right H' H)
theorem pos_of_mul_pos_left (H : 0 < a * b) (H1 : 0 ≤ a) : 0 < b :=
lt_of_not_ge
(assume H2 : b ≤ 0,
have H3 : a * b ≤ 0, from mul_nonpos_of_nonneg_of_nonpos H1 H2,
not_lt_of_le H3 H)
not_lt_of_ge H3 H)
definition pos_of_mul_pos_right (H : 0 < a * b) (H1 : 0 ≤ b) : 0 < a :=
lt_of_not_le
theorem pos_of_mul_pos_right (H : 0 < a * b) (H1 : 0 ≤ b) : 0 < a :=
lt_of_not_ge
(assume H2 : a ≤ 0,
have H3 : a * b ≤ 0, from mul_nonpos_of_nonpos_of_nonneg H2 H1,
not_lt_of_le H3 H)
not_lt_of_ge H3 H)
theorem nonneg_of_mul_nonneg_left (H : 0 ≤ a * b) (H1 : 0 < a) : 0 ≤ b :=
le_of_not_gt
(assume H2 : b < 0,
not_le_of_gt (mul_neg_of_pos_of_neg H1 H2) H)
theorem nonneg_of_mul_nonneg_right (H : 0 ≤ a * b) (H1 : 0 < b) : 0 ≤ a :=
le_of_not_gt
(assume H2 : a < 0,
not_le_of_gt (mul_neg_of_neg_of_pos H2 H1) H)
theorem neg_of_mul_neg_left (H : a * b < 0) (H1 : 0 ≤ a) : b < 0 :=
lt_of_not_ge
(assume H2 : b ≥ 0,
not_lt_of_ge (mul_nonneg H1 H2) H)
theorem neg_of_mul_neg_right (H : a * b < 0) (H1 : 0 ≤ b) : a < 0 :=
lt_of_not_ge
(assume H2 : a ≥ 0,
not_lt_of_ge (mul_nonneg H2 H1) H)
theorem nonpos_of_mul_nonpos_left (H : a * b ≤ 0) (H1 : 0 < a) : b ≤ 0 :=
le_of_not_gt
(assume H2 : b > 0,
not_le_of_gt (mul_pos H1 H2) H)
theorem nonpos_of_mul_nonpos_right (H : a * b ≤ 0) (H1 : 0 < b) : a ≤ 0 :=
le_of_not_gt
(assume H2 : a > 0,
not_le_of_gt (mul_pos H2 H1) H)
end
structure ordered_ring [class] (A : Type) extends ring A, ordered_comm_group A, zero_ne_one_class A :=
structure decidable_linear_ordered_semiring [class] (A : Type)
extends linear_ordered_semiring A, decidable_linear_order A
/- ring structures -/
structure ordered_ring [class] (A : Type)
extends ring A, ordered_comm_group A, zero_ne_one_class A :=
(mul_nonneg : Πa b, le zero a → le zero b → le zero (mul a b))
(mul_pos : Πa b, lt zero a → lt zero b → lt zero (mul a b))
definition ordered_ring.mul_le_mul_of_nonneg_left [s : ordered_ring A] {a b c : A}
theorem ordered_ring.mul_le_mul_of_nonneg_left [s : ordered_ring A] {a b c : A}
(Hab : a ≤ b) (Hc : 0 ≤ c) : c * a ≤ c * b :=
have H1 : 0 ≤ b - a, from iff.elim_right !sub_nonneg_iff_le Hab,
assert H2 : 0 ≤ c * (b - a), from ordered_ring.mul_nonneg _ _ Hc H1,
@ -161,7 +208,7 @@ begin
exact (iff.mp !sub_nonneg_iff_le H2)
end
definition ordered_ring.mul_le_mul_of_nonneg_right [s : ordered_ring A] {a b c : A}
theorem ordered_ring.mul_le_mul_of_nonneg_right [s : ordered_ring A] {a b c : A}
(Hab : a ≤ b) (Hc : 0 ≤ c) : a * c ≤ b * c :=
have H1 : 0 ≤ b - a, from iff.elim_right !sub_nonneg_iff_le Hab,
assert H2 : 0 ≤ (b - a) * c, from ordered_ring.mul_nonneg _ _ H1 Hc,
@ -170,7 +217,7 @@ begin
exact (iff.mp !sub_nonneg_iff_le H2)
end
definition ordered_ring.mul_lt_mul_of_pos_left [s : ordered_ring A] {a b c : A}
theorem ordered_ring.mul_lt_mul_of_pos_left [s : ordered_ring A] {a b c : A}
(Hab : a < b) (Hc : 0 < c) : c * a < c * b :=
have H1 : 0 < b - a, from iff.elim_right !sub_pos_iff_lt Hab,
assert H2 : 0 < c * (b - a), from ordered_ring.mul_pos _ _ Hc H1,
@ -179,7 +226,7 @@ begin
exact (iff.mp !sub_pos_iff_lt H2)
end
definition ordered_ring.mul_lt_mul_of_pos_right [s : ordered_ring A] {a b c : A}
theorem ordered_ring.mul_lt_mul_of_pos_right [s : ordered_ring A] {a b c : A}
(Hab : a < b) (Hc : 0 < c) : a * c < b * c :=
have H1 : 0 < b - a, from iff.elim_right !sub_pos_iff_lt Hab,
assert H2 : 0 < (b - a) * c, from ordered_ring.mul_pos _ _ H1 Hc,
@ -188,7 +235,8 @@ begin
exact (iff.mp !sub_pos_iff_lt H2)
end
definition ordered_ring.to_ordered_semiring [instance] [reducible] [s : ordered_ring A] :
definition ordered_ring.to_ordered_semiring [trans_instance] [reducible]
[s : ordered_ring A] :
ordered_semiring A :=
⦃ ordered_semiring, s,
mul_zero := mul_zero,
@ -199,14 +247,15 @@ definition ordered_ring.to_ordered_semiring [instance] [reducible] [s : ordered_
mul_le_mul_of_nonneg_left := @ordered_ring.mul_le_mul_of_nonneg_left A _,
mul_le_mul_of_nonneg_right := @ordered_ring.mul_le_mul_of_nonneg_right A _,
mul_lt_mul_of_pos_left := @ordered_ring.mul_lt_mul_of_pos_left A _,
mul_lt_mul_of_pos_right := @ordered_ring.mul_lt_mul_of_pos_right A _ ⦄
mul_lt_mul_of_pos_right := @ordered_ring.mul_lt_mul_of_pos_right A _,
lt_of_add_lt_add_left := @lt_of_add_lt_add_left A _⦄
section
variable [s : ordered_ring A]
variables {a b c : A}
include s
definition mul_le_mul_of_nonpos_left (H : b ≤ a) (Hc : c ≤ 0) : c * a ≤ c * b :=
theorem mul_le_mul_of_nonpos_left (H : b ≤ a) (Hc : c ≤ 0) : c * a ≤ c * b :=
have Hc' : -c ≥ 0, from iff.mpr !neg_nonneg_iff_nonpos Hc,
assert H1 : -c * b ≤ -c * a, from mul_le_mul_of_nonneg_left H Hc',
have H2 : -(c * b) ≤ -(c * a),
@ -216,7 +265,7 @@ section
end,
iff.mp !neg_le_neg_iff_le H2
definition mul_le_mul_of_nonpos_right (H : b ≤ a) (Hc : c ≤ 0) : a * c ≤ b * c :=
theorem mul_le_mul_of_nonpos_right (H : b ≤ a) (Hc : c ≤ 0) : a * c ≤ b * c :=
have Hc' : -c ≥ 0, from iff.mpr !neg_nonneg_iff_nonpos Hc,
assert H1 : b * -c ≤ a * -c, from mul_le_mul_of_nonneg_right H Hc',
have H2 : -(b * c) ≤ -(a * c),
@ -226,14 +275,14 @@ section
end,
iff.mp !neg_le_neg_iff_le H2
definition mul_nonneg_of_nonpos_of_nonpos (Ha : a ≤ 0) (Hb : b ≤ 0) : 0 ≤ a * b :=
theorem mul_nonneg_of_nonpos_of_nonpos (Ha : a ≤ 0) (Hb : b ≤ 0) : 0 ≤ a * b :=
begin
have H : 0 * b ≤ a * b, from mul_le_mul_of_nonpos_right Ha Hb,
rewrite zero_mul at H,
exact H
end
definition mul_lt_mul_of_neg_left (H : b < a) (Hc : c < 0) : c * a < c * b :=
theorem mul_lt_mul_of_neg_left (H : b < a) (Hc : c < 0) : c * a < c * b :=
have Hc' : -c > 0, from iff.mpr !neg_pos_iff_neg Hc,
assert H1 : -c * b < -c * a, from mul_lt_mul_of_pos_left H Hc',
have H2 : -(c * b) < -(c * a),
@ -243,7 +292,7 @@ section
end,
iff.mp !neg_lt_neg_iff_lt H2
definition mul_lt_mul_of_neg_right (H : b < a) (Hc : c < 0) : a * c < b * c :=
theorem mul_lt_mul_of_neg_right (H : b < a) (Hc : c < 0) : a * c < b * c :=
have Hc' : -c > 0, from iff.mpr !neg_pos_iff_neg Hc,
assert H1 : b * -c < a * -c, from mul_lt_mul_of_pos_right H Hc',
have H2 : -(b * c) < -(a * c),
@ -253,7 +302,7 @@ section
end,
iff.mp !neg_lt_neg_iff_lt H2
definition mul_pos_of_neg_of_neg (Ha : a < 0) (Hb : b < 0) : 0 < a * b :=
theorem mul_pos_of_neg_of_neg (Ha : a < 0) (Hb : b < 0) : 0 < a * b :=
begin
have H : 0 * b < a * b, from mul_lt_mul_of_neg_right Ha Hb,
rewrite zero_mul at H,
@ -264,11 +313,11 @@ end
-- TODO: we can eliminate mul_pos_of_pos, but now it is not worth the effort to redeclare the
-- class instance
structure linear_ordered_ring [class] (A : Type) extends ordered_ring A, linear_strong_order_pair A
structure linear_ordered_ring [class] (A : Type)
extends ordered_ring A, linear_strong_order_pair A :=
(zero_lt_one : lt zero one)
-- print fields linear_ordered_semiring
definition linear_ordered_ring.to_linear_ordered_semiring [instance] [reducible]
definition linear_ordered_ring.to_linear_ordered_semiring [trans_instance] [reducible]
[s : linear_ordered_ring A] :
linear_ordered_semiring A :=
⦃ linear_ordered_semiring, s,
@ -281,11 +330,12 @@ definition linear_ordered_ring.to_linear_ordered_semiring [instance] [reducible]
mul_le_mul_of_nonneg_right := @mul_le_mul_of_nonneg_right A _,
mul_lt_mul_of_pos_left := @mul_lt_mul_of_pos_left A _,
mul_lt_mul_of_pos_right := @mul_lt_mul_of_pos_right A _,
le_total := linear_ordered_ring.le_total ⦄
le_total := linear_ordered_ring.le_total,
lt_of_add_lt_add_left := @lt_of_add_lt_add_left A _ ⦄
structure linear_ordered_comm_ring [class] (A : Type) extends linear_ordered_ring A, comm_monoid A
definition linear_ordered_comm_ring.eq_zero_or_eq_zero_of_mul_eq_zero [s : linear_ordered_comm_ring A]
theorem linear_ordered_comm_ring.eq_zero_or_eq_zero_of_mul_eq_zero [s : linear_ordered_comm_ring A]
{a b : A} (H : a * b = 0) : a = 0 ⊎ b = 0 :=
lt.by_cases
(assume Ha : 0 < a,
@ -321,7 +371,7 @@ lt.by_cases
end))
-- Linearity implies no zero divisors. Doesn't need commutativity.
definition linear_ordered_comm_ring.to_integral_domain [instance] [reducible]
definition linear_ordered_comm_ring.to_integral_domain [trans_instance] [reducible]
[s: linear_ordered_comm_ring A] : integral_domain A :=
⦃ integral_domain, s,
eq_zero_or_eq_zero_of_mul_eq_zero :=
@ -332,15 +382,14 @@ section
variables (a b c : A)
include s
definition mul_self_nonneg : a * a ≥ 0 :=
sum.rec_on (le.total 0 a)
theorem mul_self_nonneg : a * a ≥ 0 :=
sum.elim (le.total 0 a)
(assume H : a ≥ 0, mul_nonneg H H)
(assume H : a ≤ 0, mul_nonneg_of_nonpos_of_nonpos H H)
definition zero_le_one : 0 ≤ (1:A) := one_mul 1 ▸ mul_self_nonneg (1 : A)
definition zero_lt_one : 0 < (1:A) := lt_of_le_of_ne zero_le_one zero_ne_one
theorem zero_le_one : 0 ≤ (1:A) := one_mul 1 ▸ mul_self_nonneg 1
definition pos_and_pos_or_neg_and_neg_of_mul_pos {a b : A} (Hab : a * b > 0) :
theorem pos_and_pos_or_neg_and_neg_of_mul_pos {a b : A} (Hab : a * b > 0) :
(a > 0 × b > 0) ⊎ (a < 0 × b < 0) :=
lt.by_cases
(assume Ha : 0 < a,
@ -369,7 +418,7 @@ section
end)
(assume Hb : b < 0, sum.inr (pair Ha Hb)))
definition gt_of_mul_lt_mul_neg_left {a b c : A} (H : c * a < c * b) (Hc : c ≤ 0) : a > b :=
theorem gt_of_mul_lt_mul_neg_left {a b c : A} (H : c * a < c * b) (Hc : c ≤ 0) : a > b :=
have nhc : -c ≥ 0, from neg_nonneg_of_nonpos Hc,
have H2 : -(c * b) < -(c * a), from iff.mpr (neg_lt_neg_iff_lt _ _) H,
have H3 : (-c) * b < (-c) * a, from calc
@ -378,9 +427,27 @@ section
... = (-c) * a : neg_mul_eq_neg_mul,
lt_of_mul_lt_mul_left H3 nhc
definition zero_gt_neg_one : -1 < (0 : A) :=
theorem zero_gt_neg_one : -1 < (0:A) :=
neg_zero ▸ (neg_lt_neg zero_lt_one)
theorem le_of_mul_le_of_ge_one {a b c : A} (H : a * c ≤ b) (Hb : b ≥ 0) (Hc : c ≥ 1) : a ≤ b :=
have H' : a * c ≤ b * c, from calc
a * c ≤ b : H
... = b * 1 : mul_one
... ≤ b * c : mul_le_mul_of_nonneg_left Hc Hb,
le_of_mul_le_mul_right H' (lt_of_lt_of_le zero_lt_one Hc)
theorem nonneg_le_nonneg_of_squares_le {a b : A} (Ha : a ≥ 0) (Hb : b ≥ 0) (H : a * a ≤ b * b) :
a ≤ b :=
begin
apply le_of_not_gt,
intro Hab,
let Hposa := lt_of_le_of_lt Hb Hab,
let H' := calc
b * b ≤ a * b : mul_le_mul_of_nonneg_right (le_of_lt Hab) Hb
... < a * a : mul_lt_mul_of_pos_left Hab Hposa,
apply (not_le_of_gt H') H
end
end
/- TODO: Isabelle's library has all kinds of cancelation rules for the simplifier.
@ -396,17 +463,17 @@ section
definition sign (a : A) : A := lt.cases a 0 (-1) 0 1
definition sign_of_neg (H : a < 0) : sign a = -1 := lt.cases_of_lt H
theorem sign_of_neg (H : a < 0) : sign a = -1 := lt.cases_of_lt H
definition sign_zero : sign 0 = (0:A) := lt.cases_of_eq rfl
theorem sign_zero : sign 0 = (0:A) := lt.cases_of_eq rfl
definition sign_of_pos (H : a > 0) : sign a = 1 := lt.cases_of_gt H
theorem sign_of_pos (H : a > 0) : sign a = 1 := lt.cases_of_gt H
definition sign_one : sign 1 = (1:A) := sign_of_pos zero_lt_one
theorem sign_one : sign 1 = (1:A) := sign_of_pos zero_lt_one
definition sign_neg_one : sign (-1) = -(1:A) := sign_of_neg (neg_neg_of_pos zero_lt_one)
theorem sign_neg_one : sign (-1) = -(1:A) := sign_of_neg (neg_neg_of_pos zero_lt_one)
definition sign_sign (a : A) : sign (sign a) = sign a :=
theorem sign_sign (a : A) : sign (sign a) = sign a :=
lt.by_cases
(assume H : a > 0,
calc
@ -424,7 +491,7 @@ section
... = -1 : by rewrite sign_neg_one
... = sign a : by rewrite (sign_of_neg H))
definition pos_of_sign_eq_one (H : sign a = 1) : a > 0 :=
theorem pos_of_sign_eq_one (H : sign a = 1) : a > 0 :=
lt.by_cases
(assume H1 : 0 < a, H1)
(assume H1 : 0 = a,
@ -436,7 +503,7 @@ section
have H2 : -1 = 1, from (sign_of_neg H1)⁻¹ ⬝ H,
absurd ((eq_zero_of_neg_eq H2)⁻¹) zero_ne_one)
definition eq_zero_of_sign_eq_zero (H : sign a = 0) : a = 0 :=
theorem eq_zero_of_sign_eq_zero (H : sign a = 0) : a = 0 :=
lt.by_cases
(assume H1 : 0 < a,
absurd (H⁻¹ ⬝ sign_of_pos H1) zero_ne_one)
@ -446,7 +513,7 @@ section
have H3 : 1 = 0, from eq_neg_of_eq_neg H2 ⬝ neg_zero,
absurd (H3⁻¹) zero_ne_one)
definition neg_of_sign_eq_neg_one (H : sign a = -1) : a < 0 :=
theorem neg_of_sign_eq_neg_one (H : sign a = -1) : a < 0 :=
lt.by_cases
(assume H1 : 0 < a,
have H2 : -1 = 1, from H⁻¹ ⬝ (sign_of_pos H1),
@ -461,7 +528,7 @@ section
absurd (H3⁻¹) zero_ne_one)
(assume H1 : 0 > a, H1)
definition sign_neg (a : A) : sign (-a) = -(sign a) :=
theorem sign_neg (a : A) : sign (-a) = -(sign a) :=
lt.by_cases
(assume H1 : 0 < a,
calc
@ -481,7 +548,7 @@ section
... = -(-1) : by rewrite neg_neg
... = -(sign a) : sign_of_neg H1)
definition sign_mul (a b : A) : sign (a * b) = sign a * sign b :=
theorem sign_mul (a b : A) : sign (a * b) = sign a * sign b :=
lt.by_cases
(assume z_lt_a : 0 < a,
lt.by_cases
@ -504,7 +571,7 @@ section
sign_of_pos (mul_pos_of_neg_of_neg z_gt_a z_gt_b),
neg_mul_neg, one_mul]))
definition abs_eq_sign_mul (a : A) : abs a = sign a * a :=
theorem abs_eq_sign_mul (a : A) : abs a = sign a * a :=
lt.by_cases
(assume H1 : 0 < a,
calc
@ -524,7 +591,7 @@ section
... = -1 * a : by rewrite neg_eq_neg_one_mul
... = sign a * a : by rewrite (sign_of_neg H1))
definition eq_sign_mul_abs (a : A) : a = sign a * abs a :=
theorem eq_sign_mul_abs (a : A) : a = sign a * abs a :=
lt.by_cases
(assume H1 : 0 < a,
calc
@ -544,16 +611,22 @@ section
... = -1 * abs a : by rewrite neg_eq_neg_one_mul
... = sign a * abs a : by rewrite (sign_of_neg H1))
definition abs_dvd_iff (a b : A) : abs a ∣ b ↔ a ∣ b :=
theorem abs_dvd_iff (a b : A) : abs a ∣ b ↔ a ∣ b :=
abs.by_cases !iff.refl !neg_dvd_iff_dvd
definition dvd_abs_iff (a b : A) : a ∣ abs b ↔ a ∣ b :=
theorem abs_dvd_of_dvd {a b : A} : a ∣ b → abs a ∣ b :=
iff.mpr !abs_dvd_iff
theorem dvd_abs_iff (a b : A) : a ∣ abs b ↔ a ∣ b :=
abs.by_cases !iff.refl !dvd_neg_iff_dvd
definition abs_mul (a b : A) : abs (a * b) = abs a * abs b :=
sum.rec_on (le.total 0 a)
theorem dvd_abs_of_dvd {a b : A} : a ∣ b → a ∣ abs b :=
iff.mpr !dvd_abs_iff
theorem abs_mul (a b : A) : abs (a * b) = abs a * abs b :=
sum.elim (le.total 0 a)
(assume H1 : 0 ≤ a,
sum.rec_on (le.total 0 b)
sum.elim (le.total 0 b)
(assume H2 : 0 ≤ b,
calc
abs (a * b) = a * b : abs_of_nonneg (mul_nonneg H1 H2)
@ -566,7 +639,7 @@ section
... = abs a * -b : by rewrite (abs_of_nonneg H1)
... = abs a * abs b : by rewrite (abs_of_nonpos H2)))
(assume H1 : a ≤ 0,
sum.rec_on (le.total 0 b)
sum.elim (le.total 0 b)
(assume H2 : 0 ≤ b,
calc
abs (a * b) = -(a * b) : abs_of_nonpos (mul_nonpos_of_nonpos_of_nonneg H1 H2)
@ -580,10 +653,92 @@ section
... = abs a * -b : by rewrite (abs_of_nonpos H1)
... = abs a * abs b : by rewrite (abs_of_nonpos H2)))
definition abs_mul_self (a : A) : abs a * abs a = a * a :=
theorem abs_mul_abs_self (a : A) : abs a * abs a = a * a :=
abs.by_cases rfl !neg_mul_neg
theorem abs_mul_self (a : A) : abs (a * a) = a * a :=
by rewrite [abs_mul, abs_mul_abs_self]
theorem sub_le_of_abs_sub_le_left (H : abs (a - b) ≤ c) : b - c ≤ a :=
if Hz : 0 ≤ a - b then
(calc
a ≥ b : (iff.mp !sub_nonneg_iff_le) Hz
... ≥ b - c : sub_le_of_nonneg _ (le.trans !abs_nonneg H))
else
(have Habs : b - a ≤ c, by rewrite [abs_of_neg (lt_of_not_ge Hz) at H, neg_sub at H]; apply H,
have Habs' : b ≤ c + a, from (iff.mpr !le_add_iff_sub_right_le) Habs,
(iff.mp !le_add_iff_sub_left_le) Habs')
theorem sub_le_of_abs_sub_le_right (H : abs (a - b) ≤ c) : a - c ≤ b :=
sub_le_of_abs_sub_le_left (!abs_sub ▸ H)
theorem sub_lt_of_abs_sub_lt_left (H : abs (a - b) < c) : b - c < a :=
if Hz : 0 ≤ a - b then
(calc
a ≥ b : (iff.mp !sub_nonneg_iff_le) Hz
... > b - c : sub_lt_of_pos _ (lt_of_le_of_lt !abs_nonneg H))
else
(have Habs : b - a < c, by rewrite [abs_of_neg (lt_of_not_ge Hz) at H, neg_sub at H]; apply H,
have Habs' : b < c + a, from lt_add_of_sub_lt_right Habs,
sub_lt_left_of_lt_add Habs')
theorem sub_lt_of_abs_sub_lt_right (H : abs (a - b) < c) : a - c < b :=
sub_lt_of_abs_sub_lt_left (!abs_sub ▸ H)
theorem abs_sub_square (a b : A) : abs (a - b) * abs (a - b) = a * a + b * b - (1 + 1) * a * b :=
begin
rewrite [abs_mul_abs_self, *mul_sub_left_distrib, *mul_sub_right_distrib,
sub_eq_add_neg (a*b), sub_add_eq_sub_sub, sub_neg_eq_add, *right_distrib, sub_add_eq_sub_sub, *one_mul,
*add.assoc, {_ + b * b}add.comm, *sub_eq_add_neg],
rewrite [{a*a + b*b}add.comm],
rewrite [mul.comm b a, *add.assoc]
end
theorem abs_abs_sub_abs_le_abs_sub (a b : A) : abs (abs a - abs b) ≤ abs (a - b) :=
begin
apply nonneg_le_nonneg_of_squares_le,
repeat apply abs_nonneg,
rewrite [*abs_sub_square, *abs_abs, *abs_mul_abs_self],
apply sub_le_sub_left,
rewrite *mul.assoc,
apply mul_le_mul_of_nonneg_left,
rewrite -abs_mul,
apply le_abs_self,
apply le_of_lt,
apply add_pos,
apply zero_lt_one,
apply zero_lt_one
end
end
/- TODO: Multiplication and one, starting with mult_right_le_one_le. -/
namespace norm_num
theorem pos_bit0_helper [s : linear_ordered_semiring A] (a : A) (H : a > 0) : bit0 a > 0 :=
by rewrite ↑bit0; apply add_pos H H
theorem nonneg_bit0_helper [s : linear_ordered_semiring A] (a : A) (H : a ≥ 0) : bit0 a ≥ 0 :=
by rewrite ↑bit0; apply add_nonneg H H
theorem pos_bit1_helper [s : linear_ordered_semiring A] (a : A) (H : a ≥ 0) : bit1 a > 0 :=
begin
rewrite ↑bit1,
apply add_pos_of_nonneg_of_pos,
apply nonneg_bit0_helper _ H,
apply zero_lt_one
end
theorem nonneg_bit1_helper [s : linear_ordered_semiring A] (a : A) (H : a ≥ 0) : bit1 a ≥ 0 :=
by apply le_of_lt; apply pos_bit1_helper _ H
theorem nonzero_of_pos_helper [s : linear_ordered_semiring A] (a : A) (H : a > 0) : a ≠ 0 :=
ne_of_gt H
theorem nonzero_of_neg_helper [s : linear_ordered_ring A] (a : A) (H : a ≠ 0) : -a ≠ 0 :=
begin intro Ha, apply H, apply eq_of_neg_eq_neg, rewrite neg_zero, exact Ha end
end norm_num
end algebra

9
hott/algebra/port.md Normal file
View file

@ -0,0 +1,9 @@
We have ported a lot of algebra files from the standard library to the HoTT library.
Port instructions for the abstract structures:
- use the script port.pl in scripts/ to port the file. e.g. execute in the scripts file:
`./port.pl ../library/algebra/lattice.lean ../hott/algebra/lattice.hlean`
- remove imports starting with `data.` or `logic.`
- open namespace algebra, and put every identifier in namespace algebra
- add option `set_option class.force_new true`
- fix all remaining errors (open namespace `eq` if needed)

6
hott/algebra/priority.hlean Normal file
View file

@ -0,0 +1,6 @@
/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
protected definition algebra.prio := num.sub std.priority.default 100

17
hott/algebra/relation.hlean
View file

@ -18,6 +18,7 @@ section
definition transitive : Type := Π⦃x y z⦄, R x y → R y z → R x z
end
/- classes for equivalence relations -/
structure is_reflexive [class] {T : Type} (R : T → T → Type) := (refl : reflexive R)
@ -70,39 +71,39 @@ namespace is_congruence
/- tools to build instances -/
theorem compose
definition compose
{T2 : Type} {R2 : T2 → T2 → Type}
{T3 : Type} {R3 : T3 → T3 → Type}
{g : T2 → T3} (C2 : is_congruence R2 R3 g)
⦃T1 : Type⦄ {R1 : T1 → T1 → Type}
{f : T1 → T2} (C1 : is_congruence R1 R2 f) :
{f : T1 → T2} [C1 : is_congruence R1 R2 f] :
is_congruence R1 R3 (λx, g (f x)) :=
is_congruence.mk (λx1 x2 H, app C2 (app C1 H))
theorem compose21
definition compose21
{T2 : Type} {R2 : T2 → T2 → Type}
{T3 : Type} {R3 : T3 → T3 → Type}
{T4 : Type} {R4 : T4 → T4 → Type}
{g : T2 → T3 → T4} (C3 : is_congruence2 R2 R3 R4 g)
⦃T1 : Type⦄ {R1 : T1 → T1 → Type}
{f1 : T1 → T2} (C1 : is_congruence R1 R2 f1)
{f2 : T1 → T3} (C2 : is_congruence R1 R3 f2) :
{f1 : T1 → T2} [C1 : is_congruence R1 R2 f1]
{f2 : T1 → T3} [C2 : is_congruence R1 R3 f2] :
is_congruence R1 R4 (λx, g (f1 x) (f2 x)) :=
is_congruence.mk (λx1 x2 H, app2 C3 (app C1 H) (app C2 H))
theorem const {T2 : Type} (R2 : T2 → T2 → Type) (H : relation.reflexive R2)
definition const {T2 : Type} (R2 : T2 → T2 → Type) (H : relation.reflexive R2)
⦃T1 : Type⦄ (R1 : T1 → T1 → Type) (c : T2) :
is_congruence R1 R2 (λu : T1, c) :=
is_congruence.mk (λx y H1, H c)
end is_congruence
theorem congruence_const [instance] {T2 : Type} (R2 : T2 → T2 → Type)
definition congruence_const [instance] {T2 : Type} (R2 : T2 → T2 → Type)
[C : is_reflexive R2] ⦃T1 : Type⦄ (R1 : T1 → T1 → Type) (c : T2) :
is_congruence R1 R2 (λu : T1, c) :=
is_congruence.const R2 (is_reflexive.refl R2) R1 c
theorem congruence_trivial [instance] {T : Type} (R : T → T → Type) :
definition congruence_star [instance] {T : Type} (R : T → T → Type) :
is_congruence R R (λu, u) :=
is_congruence.mk (λx y H, H)

421
hott/algebra/ring.hlean
View file

@ -5,40 +5,38 @@ Authors: Jeremy Avigad, Leonardo de Moura
Structures with multiplicative and additive components, including semirings, rings, and fields.
The development is modeled after Isabelle's library.
Ported from the standard library
-/
import algebra.group
open core
namespace algebra
open algebra eq
variable {A : Type}
set_option class.force_new true
/- auxiliary classes -/
namespace algebra
structure distrib [class] (A : Type) extends has_mul A, has_add A :=
(left_distrib : Πa b c, mul a (add b c) = add (mul a b) (mul a c))
(right_distrib : Πa b c, mul (add a b) c = add (mul a c) (mul b c))
definition left_distrib [s : distrib A] (a b c : A) : a * (b + c) = a * b + a * c :=
theorem left_distrib [s : distrib A] (a b c : A) : a * (b + c) = a * b + a * c :=
!distrib.left_distrib
definition right_distrib [s: distrib A] (a b c : A) : (a + b) * c = a * c + b * c :=
theorem right_distrib [s: distrib A] (a b c : A) : (a + b) * c = a * c + b * c :=
!distrib.right_distrib
structure mul_zero_class [class] (A : Type) extends has_mul A, has_zero A :=
(zero_mul : Πa, mul zero a = zero)
(mul_zero : Πa, mul a zero = zero)
definition zero_mul [s : mul_zero_class A] (a : A) : 0 * a = 0 := !mul_zero_class.zero_mul
definition mul_zero [s : mul_zero_class A] (a : A) : a * 0 = 0 := !mul_zero_class.mul_zero
theorem zero_mul [s : mul_zero_class A] (a : A) : 0 * a = 0 := !mul_zero_class.zero_mul
theorem mul_zero [s : mul_zero_class A] (a : A) : a * 0 = 0 := !mul_zero_class.mul_zero
structure zero_ne_one_class [class] (A : Type) extends has_zero A, has_one A :=
(zero_ne_one : zero ≠ one)
definition zero_ne_one [s: zero_ne_one_class A] : 0 ≠ 1 := @zero_ne_one_class.zero_ne_one A s
theorem zero_ne_one [s: zero_ne_one_class A] : 0 ≠ (1:A) := @zero_ne_one_class.zero_ne_one A s
/- semiring -/
@ -49,20 +47,26 @@ section semiring
variables [s : semiring A] (a b c : A)
include s
definition ne_zero_of_mul_ne_zero_right {a b : A} (H : a * b ≠ 0) : a ≠ 0 :=
assume H1 : a = 0,
have H2 : a * b = 0, from H1⁻¹ ▸ zero_mul b,
H H2
theorem one_add_one_eq_two : 1 + 1 = (2:A) :=
by unfold bit0
definition ne_zero_of_mul_ne_zero_left {a b : A} (H : a * b ≠ 0) : b ≠ 0 :=
assume H1 : b = 0,
have H2 : a * b = 0, from H1⁻¹ ▸ mul_zero a,
H H2
theorem ne_zero_of_mul_ne_zero_right {a b : A} (H : a * b ≠ 0) : a ≠ 0 :=
suppose a = 0,
have a * b = 0, from this⁻¹ ▸ zero_mul b,
H this
theorem ne_zero_of_mul_ne_zero_left {a b : A} (H : a * b ≠ 0) : b ≠ 0 :=
suppose b = 0,
have a * b = 0, from this⁻¹ ▸ mul_zero a,
H this
theorem distrib_three_right (a b c d : A) : (a + b + c) * d = a * d + b * d + c * d :=
by rewrite *right_distrib
end semiring
/- comm semiring -/
structure comm_semiring [class] (A : Type) extends semiring A, comm_semigroup A
structure comm_semiring [class] (A : Type) extends semiring A, comm_monoid A
-- TODO: we could also define a cancelative comm_semiring, i.e. satisfying
-- c ≠ 0 → c * a = c * b → a = b.
@ -70,29 +74,35 @@ section comm_semiring
variables [s : comm_semiring A] (a b c : A)
include s
definition dvd (a b : A) : Type := Σc, b = a * c
notation a ∣ b := dvd a b
protected definition algebra.dvd (a b : A) : Type := Σc, b = a * c
definition dvd.intro {a b c : A} (H : a * c = b) : a ∣ b :=
definition comm_semiring_has_dvd [reducible] [instance] [priority algebra.prio] : has_dvd A :=
has_dvd.mk algebra.dvd
theorem dvd.intro {a b c : A} (H : a * c = b) : a ∣ b :=
sigma.mk _ H⁻¹
definition dvd.intro_left {a b c : A} (H : c * a = b) : a ∣ b :=
theorem dvd_of_mul_right_eq {a b c : A} (H : a * c = b) : a ∣ b := dvd.intro H
theorem dvd.intro_left {a b c : A} (H : c * a = b) : a ∣ b :=
dvd.intro (!mul.comm ▸ H)
definition exists_eq_mul_right_of_dvd {a b : A} (H : a ∣ b) : Σc, b = a * c := H
theorem dvd_of_mul_left_eq {a b c : A} (H : c * a = b) : a ∣ b := dvd.intro_left H
definition dvd.elim {P : Type} {a b : A} (H₁ : a ∣ b) (H₂ : Πc, b = a * c → P) : P :=
theorem exists_eq_mul_right_of_dvd {a b : A} (H : a ∣ b) : Σc, b = a * c := H
theorem dvd.elim {P : Type} {a b : A} (H₁ : a ∣ b) (H₂ : Πc, b = a * c → P) : P :=
sigma.rec_on H₁ H₂
definition exists_eq_mul_left_of_dvd {a b : A} (H : a ∣ b) : Σc, b = c * a :=
theorem exists_eq_mul_left_of_dvd {a b : A} (H : a ∣ b) : Σc, b = c * a :=
dvd.elim H (take c, assume H1 : b = a * c, sigma.mk c (H1 ⬝ !mul.comm))
definition dvd.elim_left {P : Type} {a b : A} (H₁ : a ∣ b) (H₂ : Πc, b = c * a → P) : P :=
theorem dvd.elim_left {P : Type} {a b : A} (H₁ : a ∣ b) (H₂ : Πc, b = c * a → P) : P :=
sigma.rec_on (exists_eq_mul_left_of_dvd H₁) (take c, assume H₃ : b = c * a, H₂ c H₃)
definition dvd.refl : a ∣ a := dvd.intro !mul_one
theorem dvd.refl : a ∣ a := dvd.intro !mul_one
definition dvd.trans {a b c : A} (H₁ : a ∣ b) (H₂ : b ∣ c) : a ∣ c :=
theorem dvd.trans {a b c : A} (H₁ : a ∣ b) (H₂ : b ∣ c) : a ∣ c :=
dvd.elim H₁
(take d, assume H₃ : b = a * d,
dvd.elim H₂
@ -100,70 +110,70 @@ section comm_semiring
dvd.intro
(show a * (d * e) = c, by rewrite [-mul.assoc, -H₃, H₄])))
definition eq_zero_of_zero_dvd {a : A} (H : 0 ∣ a) : a = 0 :=
theorem eq_zero_of_zero_dvd {a : A} (H : 0 ∣ a) : a = 0 :=
dvd.elim H (take c, assume H' : a = 0 * c, H' ⬝ !zero_mul)
definition dvd_zero : a ∣ 0 := dvd.intro !mul_zero
theorem dvd_zero : a ∣ 0 := dvd.intro !mul_zero
definition one_dvd : 1 ∣ a := dvd.intro !one_mul
theorem one_dvd : 1 ∣ a := dvd.intro !one_mul
definition dvd_mul_right : a ∣ a * b := dvd.intro rfl
theorem dvd_mul_right : a ∣ a * b := dvd.intro rfl
definition dvd_mul_left : a ∣ b * a := mul.comm a b ▸ dvd_mul_right a b
theorem dvd_mul_left : a ∣ b * a := mul.comm a b ▸ dvd_mul_right a b
definition dvd_mul_of_dvd_left {a b : A} (H : a ∣ b) (c : A) : a ∣ b * c :=
theorem dvd_mul_of_dvd_left {a b : A} (H : a ∣ b) (c : A) : a ∣ b * c :=
dvd.elim H
(take d,
assume H₁ : b = a * d,
suppose b = a * d,
dvd.intro
(show a * (d * c) = b * c, from by rewrite [-mul.assoc, H₁]))
(show a * (d * c) = b * c, from by rewrite [-mul.assoc]; substvars))
definition dvd_mul_of_dvd_right {a b : A} (H : a ∣ b) (c : A) : a ∣ c * b :=
theorem dvd_mul_of_dvd_right {a b : A} (H : a ∣ b) (c : A) : a ∣ c * b :=
!mul.comm ▸ (dvd_mul_of_dvd_left H _)
definition mul_dvd_mul {a b c d : A} (dvd_ab : (a ∣ b)) (dvd_cd : c ∣ d) : a * c ∣ b * d :=
theorem mul_dvd_mul {a b c d : A} (dvd_ab : a ∣ b) (dvd_cd : c ∣ d) : a * c ∣ b * d :=
dvd.elim dvd_ab
(take e, assume Haeb : b = a * e,
(take e, suppose b = a * e,
dvd.elim dvd_cd
(take f, assume Hcfd : d = c * f,
(take f, suppose d = c * f,
dvd.intro
(show a * c * (e * f) = b * d,
by rewrite [mul.assoc, {c*_}mul.left_comm, -mul.assoc, Haeb, Hcfd])))
by rewrite [mul.assoc, {c*_}mul.left_comm, -mul.assoc]; substvars)))
definition dvd_of_mul_right_dvd {a b c : A} (H : a * b ∣ c) : a ∣ c :=
theorem dvd_of_mul_right_dvd {a b c : A} (H : a * b ∣ c) : a ∣ c :=
dvd.elim H (take d, assume Habdc : c = a * b * d, dvd.intro (!mul.assoc⁻¹ ⬝ Habdc⁻¹))
definition dvd_of_mul_left_dvd {a b c : A} (H : a * b ∣ c) : b ∣ c :=
theorem dvd_of_mul_left_dvd {a b c : A} (H : a * b ∣ c) : b ∣ c :=
dvd_of_mul_right_dvd (mul.comm a b ▸ H)
definition dvd_add {a b c : A} (Hab : a ∣ b) (Hac : a ∣ c) : a ∣ b + c :=
theorem dvd_add {a b c : A} (Hab : a ∣ b) (Hac : a ∣ c) : a ∣ b + c :=
dvd.elim Hab
(take d, assume Hadb : b = a * d,
(take d, suppose b = a * d,
dvd.elim Hac
(take e, assume Haec : c = a * e,
(take e, suppose c = a * e,
dvd.intro (show a * (d + e) = b + c,
by rewrite [left_distrib, -Hadb, -Haec])))
by rewrite [left_distrib]; substvars)))
end comm_semiring
/- ring -/
structure ring [class] (A : Type) extends add_comm_group A, monoid A, distrib A
definition ring.mul_zero [s : ring A] (a : A) : a * 0 = 0 :=
have H : a * 0 + 0 = a * 0 + a * 0, from calc
theorem ring.mul_zero [s : ring A] (a : A) : a * 0 = 0 :=
have a * 0 + 0 = a * 0 + a * 0, from calc
a * 0 + 0 = a * 0 : by rewrite add_zero
... = a * (0 + 0) : by rewrite add_zero
... = a * 0 + a * 0 : by rewrite {a*_}ring.left_distrib,
show a * 0 = 0, from (add.left_cancel H)⁻¹
show a * 0 = 0, from (add.left_cancel this)⁻¹
definition ring.zero_mul [s : ring A] (a : A) : 0 * a = 0 :=
have H : 0 * a + 0 = 0 * a + 0 * a, from calc
theorem ring.zero_mul [s : ring A] (a : A) : 0 * a = 0 :=
have 0 * a + 0 = 0 * a + 0 * a, from calc
0 * a + 0 = 0 * a : by rewrite add_zero
... = (0 + 0) * a : by rewrite add_zero
... = 0 * a + 0 * a : by rewrite {_*a}ring.right_distrib,
show 0 * a = 0, from (add.left_cancel H)⁻¹
show 0 * a = 0, from (add.left_cancel this)⁻¹
definition ring.to_semiring [instance] [reducible] [s : ring A] : semiring A :=
definition ring.to_semiring [trans_instance] [reducible] [s : ring A] : semiring A :=
⦃ semiring, s,
mul_zero := ring.mul_zero,
zero_mul := ring.zero_mul ⦄
@ -172,38 +182,41 @@ section
variables [s : ring A] (a b c d e : A)
include s
definition neg_mul_eq_neg_mul : -(a * b) = -a * b :=
theorem neg_mul_eq_neg_mul : -(a * b) = -a * b :=
neg_eq_of_add_eq_zero
begin
rewrite [-right_distrib, add.right_inv, zero_mul]
end
definition neg_mul_eq_mul_neg : -(a * b) = a * -b :=
theorem neg_mul_eq_mul_neg : -(a * b) = a * -b :=
neg_eq_of_add_eq_zero
begin
rewrite [-left_distrib, add.right_inv, mul_zero]
end
definition neg_mul_neg : -a * -b = a * b :=
theorem neg_mul_eq_neg_mul_symm : - a * b = - (a * b) := inverse !neg_mul_eq_neg_mul
theorem mul_neg_eq_neg_mul_symm : a * - b = - (a * b) := inverse !neg_mul_eq_mul_neg
theorem neg_mul_neg : -a * -b = a * b :=
calc
-a * -b = -(a * -b) : by rewrite -neg_mul_eq_neg_mul
... = - -(a * b) : by rewrite -neg_mul_eq_mul_neg
... = a * b : by rewrite neg_neg
definition neg_mul_comm : -a * b = a * -b := !neg_mul_eq_neg_mul⁻¹ ⬝ !neg_mul_eq_mul_neg
theorem neg_mul_comm : -a * b = a * -b := !neg_mul_eq_neg_mul⁻¹ ⬝ !neg_mul_eq_mul_neg
definition neg_eq_neg_one_mul : -a = -1 * a :=
theorem neg_eq_neg_one_mul : -a = -1 * a :=
calc
-a = -(1 * a) : by rewrite one_mul
... = -1 * a : by rewrite neg_mul_eq_neg_mul
definition mul_sub_left_distrib : a * (b - c) = a * b - a * c :=
theorem mul_sub_left_distrib : a * (b - c) = a * b - a * c :=
calc
a * (b - c) = a * b + a * -c : left_distrib
... = a * b + - (a * c) : by rewrite -neg_mul_eq_mul_neg
... = a * b - a * c : rfl
definition mul_sub_right_distrib : (a - b) * c = a * c - b * c :=
theorem mul_sub_right_distrib : (a - b) * c = a * c - b * c :=
calc
(a - b) * c = a * c + -b * c : right_distrib
... = a * c + - (b * c) : by rewrite neg_mul_eq_neg_mul
@ -213,36 +226,42 @@ section
-- TODO: there is also the other direction. It will be easier when we
-- have the simplifier.
definition mul_add_eq_mul_add_iff_sub_mul_add_eq : a * e + c = b * e + d ↔ (a - b) * e + c = d :=
theorem mul_add_eq_mul_add_iff_sub_mul_add_eq : a * e + c = b * e + d ↔ (a - b) * e + c = d :=
calc
a * e + c = b * e + d ↔ a * e + c = d + b * e : by rewrite {b*e+_}add.comm
... ↔ a * e + c - b * e = d : iff.symm !sub_eq_iff_eq_add
... ↔ a * e - b * e + c = d : by rewrite sub_add_eq_add_sub
... ↔ (a - b) * e + c = d : by rewrite mul_sub_right_distrib
definition mul_neg_one_eq_neg : a * (-1) = -a :=
have H : a + a * -1 = 0, from calc
theorem mul_add_eq_mul_add_of_sub_mul_add_eq : (a - b) * e + c = d → a * e + c = b * e + d :=
iff.mpr !mul_add_eq_mul_add_iff_sub_mul_add_eq
theorem sub_mul_add_eq_of_mul_add_eq_mul_add : a * e + c = b * e + d → (a - b) * e + c = d :=
iff.mp !mul_add_eq_mul_add_iff_sub_mul_add_eq
theorem mul_neg_one_eq_neg : a * (-1) = -a :=
have a + a * -1 = 0, from calc
a + a * -1 = a * 1 + a * -1 : mul_one
... = a * (1 + -1) : left_distrib
... = a * 0 : add.right_inv
... = 0 : mul_zero,
inverse (neg_eq_of_add_eq_zero H)
symm (neg_eq_of_add_eq_zero this)
definition ne_zero_and_ne_zero_of_mul_ne_zero {a b : A} (H : a * b ≠ 0) : a ≠ 0 × b ≠ 0 :=
have Ha : a ≠ 0, from
(assume Ha1 : a = 0,
have H1 : a * b = 0, by rewrite [Ha1, zero_mul],
absurd H1 H),
have Hb : b ≠ 0, from
(assume Hb1 : b = 0,
have H1 : a * b = 0, by rewrite [Hb1, mul_zero],
absurd H1 H),
pair Ha Hb
theorem ne_zero_and_ne_zero_of_mul_ne_zero {a b : A} (H : a * b ≠ 0) : a ≠ 0 × b ≠ 0 :=
have a ≠ 0, from
(suppose a = 0,
have a * b = 0, by rewrite [this, zero_mul],
absurd this H),
have b ≠ 0, from
(suppose b = 0,
have a * b = 0, by rewrite [this, mul_zero],
absurd this H),
pair `a ≠ 0` `b ≠ 0`
end
structure comm_ring [class] (A : Type) extends ring A, comm_semigroup A
definition comm_ring.to_comm_semiring [instance] [reducible] [s : comm_ring A] : comm_semiring A :=
definition comm_ring.to_comm_semiring [trans_instance] [reducible] [s : comm_ring A] : comm_semiring A :=
⦃ comm_semiring, s,
mul_zero := mul_zero,
zero_mul := zero_mul ⦄
@ -251,43 +270,58 @@ section
variables [s : comm_ring A] (a b c d e : A)
include s
definition mul_self_sub_mul_self_eq : a * a - b * b = (a + b) * (a - b) :=
by rewrite [left_distrib, *right_distrib, add.assoc, -{b*a + _}add.assoc,
-*neg_mul_eq_mul_neg, {a*b}mul.comm, add.right_inv, zero_add]
theorem mul_self_sub_mul_self_eq : a * a - b * b = (a + b) * (a - b) :=
begin
krewrite [left_distrib, *right_distrib, add.assoc],
rewrite [-{b*a + _}add.assoc,
-*neg_mul_eq_mul_neg, {a*b}mul.comm, add.right_inv, zero_add]
end
definition mul_self_sub_one_eq : a * a - 1 = (a + 1) * (a - 1) :=
mul_one 1 ▸ mul_self_sub_mul_self_eq a 1
theorem mul_self_sub_one_eq : a * a - 1 = (a + 1) * (a - 1) :=
by rewrite [-mul_self_sub_mul_self_eq, mul_one]
definition dvd_neg_iff_dvd : (a ∣ -b) ↔ (a ∣ b) :=
theorem dvd_neg_iff_dvd : (a ∣ -b) ↔ (a ∣ b) :=
iff.intro
(assume H : (a ∣ -b),
dvd.elim H
(take c, assume H' : -b = a * c,
(suppose a ∣ -b,
dvd.elim this
(take c, suppose -b = a * c,
dvd.intro
(show a * -c = b,
by rewrite [-neg_mul_eq_mul_neg, -H', neg_neg])))
(assume H : (a ∣ b),
dvd.elim H
(take c, assume H' : b = a * c,
by rewrite [-neg_mul_eq_mul_neg, -this, neg_neg])))
(suppose a ∣ b,
dvd.elim this
(take c, suppose b = a * c,
dvd.intro
(show a * -c = -b,
by rewrite [-neg_mul_eq_mul_neg, -H'])))
by rewrite [-neg_mul_eq_mul_neg, -this])))
definition neg_dvd_iff_dvd : (-a ∣ b) ↔ (a ∣ b) :=
theorem dvd_neg_of_dvd : (a ∣ b) → (a ∣ -b) :=
iff.mpr !dvd_neg_iff_dvd
theorem dvd_of_dvd_neg : (a ∣ -b) → (a ∣ b) :=
iff.mp !dvd_neg_iff_dvd
theorem neg_dvd_iff_dvd : (-a ∣ b) ↔ (a ∣ b) :=
iff.intro
(assume H : (-a ∣ b),
dvd.elim H
(take c, assume H' : b = -a * c,
(suppose -a ∣ b,
dvd.elim this
(take c, suppose b = -a * c,
dvd.intro
(show a * -c = b, by rewrite [-neg_mul_comm, H'])))
(assume H : (a ∣ b),
dvd.elim H
(take c, assume H' : b = a * c,
(show a * -c = b, by rewrite [-neg_mul_comm, this])))
(suppose a ∣ b,
dvd.elim this
(take c, suppose b = a * c,
dvd.intro
(show -a * -c = b, by rewrite [neg_mul_neg, H'])))
(show -a * -c = b, by rewrite [neg_mul_neg, this])))
definition dvd_sub (H₁ : (a ∣ b)) (H₂ : (a ∣ c)) : (a ∣ b - c) :=
dvd_add H₁ (iff.elim_right !dvd_neg_iff_dvd H₂)
theorem neg_dvd_of_dvd : (a ∣ b) → (-a ∣ b) :=
iff.mpr !neg_dvd_iff_dvd
theorem dvd_of_neg_dvd : (-a ∣ b) → (a ∣ b) :=
iff.mp !neg_dvd_iff_dvd
theorem dvd_sub (H₁ : (a ∣ b)) (H₂ : (a ∣ c)) : (a ∣ b - c) :=
dvd_add H₁ (!dvd_neg_of_dvd H₂)
end
/- integral domains -/
@ -295,67 +329,172 @@ end
structure no_zero_divisors [class] (A : Type) extends has_mul A, has_zero A :=
(eq_zero_or_eq_zero_of_mul_eq_zero : Πa b, mul a b = zero → a = zero ⊎ b = zero)
definition eq_zero_or_eq_zero_of_mul_eq_zero {A : Type} [s : no_zero_divisors A] {a b : A}
theorem eq_zero_or_eq_zero_of_mul_eq_zero {A : Type} [s : no_zero_divisors A] {a b : A}
(H : a * b = 0) :
a = 0 ⊎ b = 0 := !no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero H
structure integral_domain [class] (A : Type) extends comm_ring A, no_zero_divisors A
structure integral_domain [class] (A : Type) extends comm_ring A, no_zero_divisors A,
zero_ne_one_class A
section
variables [s : integral_domain A] (a b c d e : A)
include s
definition mul_ne_zero {a b : A} (H1 : a ≠ 0) (H2 : b ≠ 0) : a * b ≠ 0 :=
assume H : a * b = 0,
sum.rec_on (eq_zero_or_eq_zero_of_mul_eq_zero H) (assume H3, H1 H3) (assume H4, H2 H4)
theorem mul_ne_zero {a b : A} (H1 : a ≠ 0) (H2 : b ≠ 0) : a * b ≠ 0 :=
suppose a * b = 0,
sum.elim (eq_zero_or_eq_zero_of_mul_eq_zero this) (assume H3, H1 H3) (assume H4, H2 H4)
definition eq_of_mul_eq_mul_right {a b c : A} (Ha : a ≠ 0) (H : b * a = c * a) : b = c :=
have H1 : b * a - c * a = 0, from iff.mp !eq_iff_sub_eq_zero H,
have H2 : (b - c) * a = 0, using H1, by rewrite [mul_sub_right_distrib, H1],
have H3 : b - c = 0, from sum_resolve_left (eq_zero_or_eq_zero_of_mul_eq_zero H2) Ha,
iff.elim_right !eq_iff_sub_eq_zero H3
theorem eq_of_mul_eq_mul_right {a b c : A} (Ha : a ≠ 0) (H : b * a = c * a) : b = c :=
have b * a - c * a = 0, from iff.mp !eq_iff_sub_eq_zero H,
have (b - c) * a = 0, using this, by rewrite [mul_sub_right_distrib, this],
have b - c = 0, from sum_resolve_left (eq_zero_or_eq_zero_of_mul_eq_zero this) Ha,
iff.elim_right !eq_iff_sub_eq_zero this
definition eq_of_mul_eq_mul_left {a b c : A} (Ha : a ≠ 0) (H : a * b = a * c) : b = c :=
have H1 : a * b - a * c = 0, from iff.mp !eq_iff_sub_eq_zero H,
have H2 : a * (b - c) = 0, using H1, by rewrite [mul_sub_left_distrib, H1],
have H3 : b - c = 0, from sum_resolve_right (eq_zero_or_eq_zero_of_mul_eq_zero H2) Ha,
iff.elim_right !eq_iff_sub_eq_zero H3
theorem eq_of_mul_eq_mul_left {a b c : A} (Ha : a ≠ 0) (H : a * b = a * c) : b = c :=
have a * b - a * c = 0, from iff.mp !eq_iff_sub_eq_zero H,
have a * (b - c) = 0, using this, by rewrite [mul_sub_left_distrib, this],
have b - c = 0, from sum_resolve_right (eq_zero_or_eq_zero_of_mul_eq_zero this) Ha,
iff.elim_right !eq_iff_sub_eq_zero this
-- TODO: do we want the iff versions?
definition mul_self_eq_mul_self_iff (a b : A) : a * a = b * b ↔ a = b ⊎ a = -b :=
iff.intro
(λ H : a * a = b * b,
have aux₁ : (a - b) * (a + b) = 0,
by rewrite [mul.comm, -mul_self_sub_mul_self_eq, H, sub_self],
assert aux₂ : a - b = 0 ⊎ a + b = 0, from !eq_zero_or_eq_zero_of_mul_eq_zero aux₁,
sum.rec_on aux₂
(λ H : a - b = 0, sum.inl (eq_of_sub_eq_zero H))
(λ H : a + b = 0, sum.inr (eq_neg_of_add_eq_zero H)))
(λ H : a = b ⊎ a = -b, sum.rec_on H
(λ a_eq_b, by rewrite a_eq_b)
(λ a_eq_mb, by rewrite [a_eq_mb, neg_mul_neg]))
theorem eq_zero_of_mul_eq_self_right {a b : A} (H₁ : b ≠ 1) (H₂ : a * b = a) : a = 0 :=
have b - 1 ≠ 0, from
suppose b - 1 = 0, H₁ (!zero_add ▸ eq_add_of_sub_eq this),
have a * b - a = 0, by rewrite H₂; apply sub_self,
have a * (b - 1) = 0, by+ rewrite [mul_sub_left_distrib, mul_one]; apply this,
show a = 0, from sum_resolve_left (eq_zero_or_eq_zero_of_mul_eq_zero this) `b - 1 ≠ 0`
definition mul_self_eq_one_iff (a : A) : a * a = 1 ↔ a = 1 ⊎ a = -1 :=
assert aux : a * a = 1 * 1 ↔ a = 1 ⊎ a = -1, from mul_self_eq_mul_self_iff a 1,
by rewrite mul_one at aux; exact aux
theorem eq_zero_of_mul_eq_self_left {a b : A} (H₁ : b ≠ 1) (H₂ : b * a = a) : a = 0 :=
eq_zero_of_mul_eq_self_right H₁ (!mul.comm ▸ H₂)
theorem mul_self_eq_mul_self_iff (a b : A) : a * a = b * b ↔ a = b ⊎ a = -b :=
iff.intro
(suppose a * a = b * b,
have (a - b) * (a + b) = 0,
by rewrite [mul.comm, -mul_self_sub_mul_self_eq, this, sub_self],
assert a - b = 0 ⊎ a + b = 0, from !eq_zero_or_eq_zero_of_mul_eq_zero this,
sum.elim this
(suppose a - b = 0, sum.inl (eq_of_sub_eq_zero this))
(suppose a + b = 0, sum.inr (eq_neg_of_add_eq_zero this)))
(suppose a = b ⊎ a = -b, sum.elim this
(suppose a = b, by rewrite this)
(suppose a = -b, by rewrite [this, neg_mul_neg]))
theorem mul_self_eq_one_iff (a : A) : a * a = 1 ↔ a = 1 ⊎ a = -1 :=
assert a * a = 1 * 1 ↔ a = 1 ⊎ a = -1, from mul_self_eq_mul_self_iff a 1,
by rewrite mul_one at this; exact this
-- TODO: c - b * c → c = 0 ⊎ b = 1 and variants
definition dvd_of_mul_dvd_mul_left {a b c : A} (Ha : a ≠ 0) (Hdvd : (a * b ∣ a * c)) : (b ∣ c) :=
theorem dvd_of_mul_dvd_mul_left {a b c : A} (Ha : a ≠ 0) (Hdvd : (a * b ∣ a * c)) : (b ∣ c) :=
dvd.elim Hdvd
(take d,
assume H : a * c = a * b * d,
have H1 : b * d = c, from eq_of_mul_eq_mul_left Ha (mul.assoc a b d ▸ H⁻¹),
dvd.intro H1)
suppose a * c = a * b * d,
have b * d = c, from eq_of_mul_eq_mul_left Ha (mul.assoc a b d ▸ this⁻¹),
dvd.intro this)
definition dvd_of_mul_dvd_mul_right {a b c : A} (Ha : a ≠ 0) (Hdvd : (b * a ∣ c * a)) : (b ∣ c) :=
theorem dvd_of_mul_dvd_mul_right {a b c : A} (Ha : a ≠ 0) (Hdvd : (b * a ∣ c * a)) : (b ∣ c) :=
dvd.elim Hdvd
(take d,
assume H : c * a = b * a * d,
have H1 : b * d * a = c * a, from by rewrite [mul.right_comm, -H],
have H2 : b * d = c, from eq_of_mul_eq_mul_right Ha H1,
dvd.intro H2)
suppose c * a = b * a * d,
have b * d * a = c * a, from by rewrite [mul.right_comm, -this],
have b * d = c, from eq_of_mul_eq_mul_right Ha this,
dvd.intro this)
end
namespace norm_num
theorem mul_zero [s : mul_zero_class A] (a : A) : a * zero = zero :=
by rewrite [↑zero, mul_zero]
theorem zero_mul [s : mul_zero_class A] (a : A) : zero * a = zero :=
by rewrite [↑zero, zero_mul]
theorem mul_one [s : monoid A] (a : A) : a * one = a :=
by rewrite [↑one, mul_one]
theorem mul_bit0 [s : distrib A] (a b : A) : a * (bit0 b) = bit0 (a * b) :=
by rewrite [↑bit0, left_distrib]
theorem mul_bit0_helper [s : distrib A] (a b t : A) (H : a * b = t) : a * (bit0 b) = bit0 t :=
by rewrite -H; apply mul_bit0
theorem mul_bit1 [s : semiring A] (a b : A) : a * (bit1 b) = bit0 (a * b) + a :=
by rewrite [↑bit1, ↑bit0, +left_distrib, ↑one, mul_one]
theorem mul_bit1_helper [s : semiring A] (a b s t : A) (Hs : a * b = s) (Ht : bit0 s + a = t) :
a * (bit1 b) = t :=
begin rewrite [-Ht, -Hs, mul_bit1] end
theorem subst_into_prod [s : has_mul A] (l r tl tr t : A) (prl : l = tl) (prr : r = tr)
(prt : tl * tr = t) :
l * r = t :=
by rewrite [prl, prr, prt]
theorem mk_cong (op : A → A) (a b : A) (H : a = b) : op a = op b :=
by congruence; exact H
theorem mk_eq (a : A) : a = a := rfl
theorem neg_add_neg_eq_of_add_add_eq_zero [s : add_comm_group A] (a b c : A) (H : c + a + b = 0) :
-a + -b = c :=
begin
apply add_neg_eq_of_eq_add,
apply neg_eq_of_add_eq_zero,
rewrite [add.comm, add.assoc, add.comm b, -add.assoc, H]
end
theorem neg_add_neg_helper [s : add_comm_group A] (a b c : A) (H : a + b = c) : -a + -b = -c :=
begin apply iff.mp !neg_eq_neg_iff_eq, rewrite [neg_add, *neg_neg, H] end
theorem neg_add_pos_eq_of_eq_add [s : add_comm_group A] (a b c : A) (H : b = c + a) : -a + b = c :=
begin apply neg_add_eq_of_eq_add, rewrite add.comm, exact H end
theorem neg_add_pos_helper1 [s : add_comm_group A] (a b c : A) (H : b + c = a) : -a + b = -c :=
begin apply neg_add_eq_of_eq_add, apply eq_add_neg_of_add_eq H end
theorem neg_add_pos_helper2 [s : add_comm_group A] (a b c : A) (H : a + c = b) : -a + b = c :=
begin apply neg_add_eq_of_eq_add, rewrite H end
theorem pos_add_neg_helper [s : add_comm_group A] (a b c : A) (H : b + a = c) : a + b = c :=
by rewrite [add.comm, H]
theorem sub_eq_add_neg_helper [s : add_comm_group A] (t₁ t₂ e w₁ w₂: A) (H₁ : t₁ = w₁)
(H₂ : t₂ = w₂) (H : w₁ + -w₂ = e) : t₁ - t₂ = e :=
by rewrite [sub_eq_add_neg, H₁, H₂, H]
theorem pos_add_pos_helper [s : add_comm_group A] (a b c h₁ h₂ : A) (H₁ : a = h₁) (H₂ : b = h₂)
(H : h₁ + h₂ = c) : a + b = c :=
by rewrite [H₁, H₂, H]
theorem subst_into_subtr [s : add_group A] (l r t : A) (prt : l + -r = t) : l - r = t :=
by rewrite [sub_eq_add_neg, prt]
theorem neg_neg_helper [s : add_group A] (a b : A) (H : a = -b) : -a = b :=
by rewrite [H, neg_neg]
theorem neg_mul_neg_helper [s : ring A] (a b c : A) (H : a * b = c) : (-a) * (-b) = c :=
begin rewrite [neg_mul_neg, H] end
theorem neg_mul_pos_helper [s : ring A] (a b c : A) (H : a * b = c) : (-a) * b = -c :=
begin rewrite [-neg_mul_eq_neg_mul, H] end
theorem pos_mul_neg_helper [s : ring A] (a b c : A) (H : a * b = c) : a * (-b) = -c :=
begin rewrite [-neg_mul_comm, -neg_mul_eq_neg_mul, H] end
end norm_num
end algebra
open algebra
attribute [simp]
zero_mul mul_zero
at simplifier.unit
attribute [simp]
neg_mul_eq_neg_mul_symm mul_neg_eq_neg_mul_symm
at simplifier.neg
attribute [simp]
left_distrib right_distrib
at simplifier.distrib

12
hott/init/datatypes.hlean
View file

@ -92,10 +92,14 @@ inductive string : Type :=
| empty : string
| str : char → string → string
inductive nat :=
| zero : nat
| succ : nat → nat
inductive option (A : Type) : Type :=
| none {} : option A
| some : A → option A
-- Remark: we manually generate the nat.rec_on, nat.induction_on, nat.cases_on and nat.no_confusion.
-- We do that because we want 0 instead of nat.zero in these eliminators.
set_option inductive.rec_on false
set_option inductive.cases_on false
inductive nat :=
| zero : nat
| succ : nat → nat

10
hott/init/logic.hlean
View file

@ -61,13 +61,13 @@ namespace eq
theorem mpr {a b : Type} : (a = b) → b → a :=
assume H₁ H₂, eq.rec_on (eq.symm H₁) H₂
namespace ops
postfix ⁻¹ := symm --input with \sy or \-1 or \inv
infixl ⬝ := trans
infixr ▸ := subst
end ops
namespace ops end ops -- this is just to ensure that this namespace exists. There is nothing in it
end eq
local postfix ⁻¹ := eq.symm --input with \sy or \-1 or \inv
local infixl ⬝ := eq.trans
local infixr ▸ := eq.subst
-- Auxiliary definition used by automation. It has the same type of eq.rec in the standard library
definition eq.nrec.{l₁ l₂} {A : Type.{l₂}} {a : A} {C : A → Type.{l₁}} (H₁ : C a) (b : A) (H₂ : a = b) : C b :=
eq.rec H₁ H₂

370
hott/init/nat.hlean
View file

@ -4,50 +4,74 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Leonardo de Moura
-/
prelude
import init.wf init.tactic init.hedberg init.util init.types
open eq decidable sum lift is_trunc
import init.wf init.tactic init.num init.types init.path
open eq eq.ops decidable
open algebra sum
set_option class.force_new true
notation `ℕ` := nat
namespace nat
protected definition rec_on [reducible] [recursor] [unfold 2]
{C : ℕ → Type} (n : ℕ) (H₁ : C 0) (H₂ : Π (a : ℕ), C a → C (succ a)) : C n :=
nat.rec H₁ H₂ n
protected definition cases_on [reducible] [recursor] [unfold 2]
{C : ℕ → Type} (n : ℕ) (H₁ : C 0) (H₂ : Π (a : ℕ), C (succ a)) : C n :=
nat.rec H₁ (λ a ih, H₂ a) n
protected definition no_confusion_type.{u} [reducible] (P : Type.{u}) (v₁ v₂ : ℕ) : Type.{u} :=
nat.rec
(nat.rec
(P → lift P)
(λ a₂ ih, lift P)
v₂)
(λ a₁ ih, nat.rec
(lift P)
(λ a₂ ih, (a₁ = a₂ → P) → lift P)
v₂)
v₁
protected definition no_confusion [reducible] [unfold 4]
{P : Type} {v₁ v₂ : ℕ} (H : v₁ = v₂) : nat.no_confusion_type P v₁ v₂ :=
eq.rec (λ H₁ : v₁ = v₁, nat.rec (λ h, lift.up h) (λ a ih h, lift.up (h (eq.refl a))) v₁) H H
/- basic definitions on natural numbers -/
inductive le (a : ℕ) : ℕ → Type₀ :=
| refl : le a a
inductive le (a : ℕ) : ℕ → Type :=
| nat_refl : le a a -- use nat_refl to avoid overloading le.refl
| step : Π {b}, le a b → le a (succ b)
infix ` ≤ ` := le
attribute le.refl [refl]
definition nat_has_le [instance] [reducible] [priority nat.prio]: has_le nat := has_le.mk nat.le
definition lt [reducible] (n m : ℕ) := succ n ≤ m
definition ge [reducible] (n m : ℕ) := m ≤ n
definition gt [reducible] (n m : ℕ) := succ m ≤ n
infix ` < ` := lt
infix ` ≥ ` := ge
infix ` > ` := gt
protected lemma le_refl [refl] : Π a : nat, a ≤ a :=
le.nat_refl
protected definition lt [reducible] (n m : ℕ) := succ n ≤ m
definition nat_has_lt [instance] [reducible] [priority nat.prio] : has_lt nat := has_lt.mk nat.lt
definition pred [unfold 1] (a : nat) : nat :=
nat.cases_on a zero (λ a₁, a₁)
-- add is defined in init.num
definition sub (a b : nat) : nat :=
nat.rec_on b a (λ b₁ r, pred r)
protected definition sub (a b : nat) : nat :=
nat.rec_on b a (λ b₁, pred)
definition mul (a b : nat) : nat :=
protected definition mul (a b : nat) : nat :=
nat.rec_on b zero (λ b₁ r, r + a)
notation a - b := sub a b
notation a * b := mul a b
definition nat_has_sub [instance] [reducible] [priority nat.prio] : has_sub nat :=
has_sub.mk nat.sub
definition nat_has_mul [instance] [reducible] [priority nat.prio] : has_mul nat :=
has_mul.mk nat.mul
/- properties of ℕ -/
protected definition is_inhabited [instance] : inhabited nat :=
inhabited.mk zero
protected definition has_decidable_eq [instance] : ∀ x y : nat, decidable (x = y)
protected definition has_decidable_eq [instance] [priority nat.prio] : Π x y : nat, decidable (x = y)
| has_decidable_eq zero zero := inl rfl
| has_decidable_eq (succ x) zero := inr (by contradiction)
| has_decidable_eq zero (succ y) := inr (by contradiction)
@ -59,109 +83,110 @@ namespace nat
/- properties of inequality -/
definition le_of_eq {n m : ℕ} (p : n = m) : n ≤ m := p ▸ le.refl n
protected theorem le_of_eq {n m : ℕ} (p : n = m) : n ≤ m := p ▸ !nat.le_refl
definition le_succ (n : ℕ) : n ≤ succ n := by repeat constructor
theorem le_succ (n : ℕ) : n ≤ succ n := le.step !nat.le_refl
definition pred_le (n : ℕ) : pred n ≤ n := by cases n;all_goals (repeat constructor)
theorem pred_le (n : ℕ) : pred n ≤ n := by cases n;repeat constructor
definition le.trans [trans] {n m k : ℕ} (H1 : n ≤ m) (H2 : m ≤ k) : n ≤ k :=
by induction H2 with n H2 IH;exact H1;exact le.step IH
theorem le_succ_iff_unit [simp] (n : ℕ) : n ≤ succ n ↔ unit :=
iff_unit_intro (le_succ n)
definition le_succ_of_le {n m : ℕ} (H : n ≤ m) : n ≤ succ m := le.trans H !le_succ
theorem pred_le_iff_unit [simp] (n : ℕ) : pred n ≤ n ↔ unit :=
iff_unit_intro (pred_le n)
definition le_of_succ_le {n m : ℕ} (H : succ n ≤ m) : n ≤ m := le.trans !le_succ H
protected theorem le_trans {n m k : ℕ} (H1 : n ≤ m) : m ≤ k → n ≤ k :=
le.rec H1 (λp H2, le.step)
definition le_of_lt {n m : ℕ} (H : n < m) : n ≤ m := le_of_succ_le H
theorem le_succ_of_le {n m : ℕ} (H : n ≤ m) : n ≤ succ m := nat.le_trans H !le_succ
definition succ_le_succ [unfold 3] {n m : ℕ} (H : n ≤ m) : succ n ≤ succ m :=
by induction H;reflexivity;exact le.step v_0
theorem le_of_succ_le {n m : ℕ} (H : succ n ≤ m) : n ≤ m := nat.le_trans !le_succ H
definition pred_le_pred [unfold 3] {n m : ℕ} (H : n ≤ m) : pred n ≤ pred m :=
by induction H;reflexivity;cases b;exact v_0;exact le.step v_0
protected theorem le_of_lt {n m : ℕ} (H : n < m) : n ≤ m := le_of_succ_le H
definition le_of_succ_le_succ [unfold 3] {n m : ℕ} (H : succ n ≤ succ m) : n ≤ m :=
pred_le_pred H
theorem succ_le_succ {n m : ℕ} : n ≤ m → succ n ≤ succ m :=
le.rec !nat.le_refl (λa b, le.step)
definition le_succ_of_pred_le [unfold 1] {n m : ℕ} (H : pred n ≤ m) : n ≤ succ m :=
by cases n;exact le.step H;exact succ_le_succ H
theorem pred_le_pred {n m : ℕ} : n ≤ m → pred n ≤ pred m :=
le.rec !nat.le_refl (nat.rec (λa b, b) (λa b c, le.step))
definition not_succ_le_self {n : ℕ} : ¬succ n ≤ n :=
by induction n with n IH;all_goals intros;cases a;apply IH;exact le_of_succ_le_succ a
theorem le_of_succ_le_succ {n m : ℕ} : succ n ≤ succ m → n ≤ m :=
pred_le_pred
definition zero_le (n : ℕ) : 0 ≤ n :=
by induction n with n IH;apply le.refl;exact le.step IH
theorem le_succ_of_pred_le {n m : ℕ} : pred n ≤ m → n ≤ succ m :=
nat.cases_on n le.step (λa, succ_le_succ)
definition lt.step {n m : ℕ} (H : n < m) : n < succ m :=
le.step H
definition zero_lt_succ (n : ℕ) : 0 < succ n :=
by induction n with n IH;apply le.refl;exact le.step IH
definition lt.trans [trans] {n m k : ℕ} (H1 : n < m) (H2 : m < k) : n < k :=
le.trans (le.step H1) H2
definition lt_of_le_of_lt [trans] {n m k : ℕ} (H1 : n ≤ m) (H2 : m < k) : n < k :=
le.trans (succ_le_succ H1) H2
definition lt_of_lt_of_le [trans] {n m k : ℕ} (H1 : n < m) (H2 : m ≤ k) : n < k :=
le.trans H1 H2
definition le.antisymm {n m : ℕ} (H1 : n ≤ m) (H2 : m ≤ n) : n = m :=
begin
cases H1 with m' H1',
{ reflexivity},
{ cases H2 with n' H2',
{ reflexivity},
{ exfalso, apply not_succ_le_self, exact lt.trans H1' H2'}},
end
definition not_succ_le_zero (n : ℕ) : ¬succ n ≤ zero :=
theorem not_succ_le_zero (n : ℕ) : ¬succ n ≤ 0 :=
by intro H; cases H
definition lt.irrefl (n : ℕ) : ¬n < n := not_succ_le_self
theorem succ_le_zero_iff_empty (n : ℕ) : succ n ≤ 0 ↔ empty :=
iff_empty_intro !not_succ_le_zero
definition self_lt_succ (n : ℕ) : n < succ n := !le.refl
definition lt.base (n : ℕ) : n < succ n := !le.refl
theorem not_succ_le_self : Π {n : ℕ}, ¬succ n ≤ n :=
nat.rec !not_succ_le_zero (λa b c, b (le_of_succ_le_succ c))
definition le_lt_antisymm {n m : ℕ} (H1 : n ≤ m) (H2 : m < n) : empty :=
!lt.irrefl (lt_of_le_of_lt H1 H2)
theorem succ_le_self_iff_empty [simp] (n : ℕ) : succ n ≤ n ↔ empty :=
iff_empty_intro not_succ_le_self
definition lt_le_antisymm {n m : ℕ} (H1 : n < m) (H2 : m ≤ n) : empty :=
theorem zero_le : Π (n : ℕ), 0 ≤ n :=
nat.rec !nat.le_refl (λa, le.step)
theorem zero_le_iff_unit [simp] (n : ℕ) : 0 ≤ n ↔ unit :=
iff_unit_intro !zero_le
theorem lt.step {n m : ℕ} : n < m → n < succ m := le.step
theorem zero_lt_succ (n : ℕ) : 0 < succ n :=
succ_le_succ !zero_le
theorem zero_lt_succ_iff_unit [simp] (n : ℕ) : 0 < succ n ↔ unit :=
iff_unit_intro (zero_lt_succ n)
protected theorem lt_trans {n m k : ℕ} (H1 : n < m) : m < k → n < k :=
nat.le_trans (le.step H1)
protected theorem lt_of_le_of_lt {n m k : ℕ} (H1 : n ≤ m) : m < k → n < k :=
nat.le_trans (succ_le_succ H1)
protected theorem lt_of_lt_of_le {n m k : ℕ} : n < m → m ≤ k → n < k := nat.le_trans
protected theorem lt_irrefl (n : ℕ) : ¬n < n := not_succ_le_self
theorem lt_self_iff_empty (n : ℕ) : n < n ↔ empty :=
iff_empty_intro (λ H, absurd H (nat.lt_irrefl n))
theorem self_lt_succ (n : ℕ) : n < succ n := !nat.le_refl
theorem self_lt_succ_iff_unit [simp] (n : ℕ) : n < succ n ↔ unit :=
iff_unit_intro (self_lt_succ n)
theorem lt.base (n : ℕ) : n < succ n := !nat.le_refl
theorem le_lt_antisymm {n m : ℕ} (H1 : n ≤ m) (H2 : m < n) : empty :=
!nat.lt_irrefl (nat.lt_of_le_of_lt H1 H2)
protected theorem le_antisymm {n m : ℕ} (H1 : n ≤ m) : m ≤ n → n = m :=
le.cases_on H1 (λa, rfl) (λa b c, absurd (nat.lt_of_le_of_lt b c) !nat.lt_irrefl)
theorem lt_le_antisymm {n m : ℕ} (H1 : n < m) (H2 : m ≤ n) : empty :=
le_lt_antisymm H2 H1
definition lt.asymm {n m : ℕ} (H1 : n < m) (H2 : m < n) : empty :=
le_lt_antisymm (le_of_lt H1) H2
protected theorem nat.lt_asymm {n m : ℕ} (H1 : n < m) : ¬ m < n :=
le_lt_antisymm (nat.le_of_lt H1)
definition lt.trichotomy (a b : ℕ) : a < b ⊎ a = b ⊎ b < a :=
begin
revert b, induction a with a IH,
{ intro b, cases b,
exact inr (inl idp),
exact inl !zero_lt_succ},
{ intro b, cases b with b,
exact inr (inr !zero_lt_succ),
{ cases IH b with H H,
exact inl (succ_le_succ H),
cases H with H H,
exact inr (inl (ap succ H)),
exact inr (inr (succ_le_succ H))}}
end
theorem not_lt_zero (a : ℕ) : ¬ a < 0 := !not_succ_le_zero
definition lt.by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a = b → P) (H3 : b < a → P) : P :=
by induction (lt.trichotomy a b) with H H; exact H1 H; cases H with H H; exact H2 H;exact H3 H
theorem lt_zero_iff_empty [simp] (a : ℕ) : a < 0 ↔ empty :=
iff_empty_intro (not_lt_zero a)
definition lt_ge_by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a ≥ b → P) : P :=
lt.by_cases H1 (λH, H2 (le_of_eq H⁻¹)) (λH, H2 (le_of_lt H))
protected theorem eq_or_lt_of_le {a b : ℕ} (H : a ≤ b) : a = b ⊎ a < b :=
le.cases_on H (inl rfl) (λn h, inr (succ_le_succ h))
definition lt_or_ge (a b : ℕ) : (a < b) ⊎ (a ≥ b) :=
lt_ge_by_cases inl inr
definition not_lt_zero (a : ℕ) : ¬ a < zero :=
by intro H; cases H
protected theorem le_of_eq_or_lt {a b : ℕ} (H : a = b ⊎ a < b) : a ≤ b :=
sum.rec_on H !nat.le_of_eq !nat.le_of_lt
-- less-than is well-founded
definition lt.wf [instance] : well_founded lt :=
definition lt.wf [instance] : well_founded (lt : ℕ → ℕ → Type₀) :=
begin
constructor, intro n, induction n with n IH,
{ constructor, intros n H, exfalso, exact !not_lt_zero H},
@ -170,130 +195,87 @@ namespace nat
{ intros n₁ hlt, induction hlt,
{ intro p, injection p with q, exact q ▸ IH},
{ intro p, injection p with q, exact (acc.inv (q ▸ IH) a)}},
apply aux H idp},
apply aux H rfl},
end
definition measure {A : Type} (f : A → ℕ) : A → A → Type₀ :=
inv_image lt f
definition measure {A : Type} : (A → ℕ) → A → A → Type₀ :=
inv_image lt
definition measure.wf {A : Type} (f : A → ℕ) : well_founded (measure f) :=
inv_image.wf f lt.wf
definition succ_lt_succ {a b : ℕ} (H : a < b) : succ a < succ b :=
succ_le_succ H
theorem succ_lt_succ {a b : ℕ} : a < b → succ a < succ b :=
succ_le_succ
definition lt_of_succ_lt {a b : ℕ} (H : succ a < b) : a < b :=
le_of_succ_le H
theorem lt_of_succ_lt {a b : ℕ} : succ a < b → a < b :=
le_of_succ_le
definition lt_of_succ_lt_succ {a b : ℕ} (H : succ a < succ b) : a < b :=
le_of_succ_le_succ H
theorem lt_of_succ_lt_succ {a b : ℕ} : succ a < succ b → a < b :=
le_of_succ_le_succ
definition decidable_le [instance] : decidable_rel le :=
begin
intros n, induction n with n IH,
{ intro m, left, apply zero_le},
{ intro m, cases m with m,
{ right, apply not_succ_le_zero},
{ let H := IH m, clear IH,
cases H with H H,
left, exact succ_le_succ H,
right, intro H2, exact H (le_of_succ_le_succ H2)}}
end
definition decidable_le [instance] [priority nat.prio] : Π a b : nat, decidable (a ≤ b) :=
nat.rec (λm, (decidable.inl !zero_le))
(λn IH m, !nat.cases_on (decidable.inr (not_succ_le_zero n))
(λm, decidable.rec (λH, inl (succ_le_succ H))
(λH, inr (λa, H (le_of_succ_le_succ a))) (IH m)))
definition decidable_lt [instance] : decidable_rel lt := _
definition decidable_gt [instance] : decidable_rel gt := _
definition decidable_ge [instance] : decidable_rel ge := _
definition decidable_lt [instance] [priority nat.prio] : Π a b : nat, decidable (a < b) :=
λ a b, decidable_le (succ a) b
definition eq_or_lt_of_le {a b : ℕ} (H : a ≤ b) : a = b ⊎ a < b :=
by cases H with b' H; exact sum.inl rfl; exact sum.inr (succ_le_succ H)
protected theorem lt_or_ge (a b : ℕ) : a < b ⊎ a ≥ b :=
nat.rec (inr !zero_le) (λn, sum.rec
(λh, inl (le_succ_of_le h))
(λh, sum.rec_on (nat.eq_or_lt_of_le h) (λe, inl (eq.subst e !nat.le_refl)) inr)) b
protected definition lt_ge_by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a ≥ b → P) : P :=
by_cases H1 (λh, H2 (sum.rec_on !nat.lt_or_ge (λa, absurd a h) (λa, a)))
definition le_of_eq_or_lt {a b : ℕ} (H : a = b ⊎ a < b) : a ≤ b :=
by cases H with H H; exact le_of_eq H; exact le_of_lt H
protected definition lt_by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a = b → P)
(H3 : b < a → P) : P :=
nat.lt_ge_by_cases H1 (λh₁,
nat.lt_ge_by_cases H3 (λh₂, H2 (nat.le_antisymm h₂ h₁)))
definition eq_or_lt_of_not_lt {a b : ℕ} (hnlt : ¬ a < b) : a = b ⊎ b < a :=
sum.rec_on (lt.trichotomy a b)
protected theorem lt_trichotomy (a b : ℕ) : a < b ⊎ a = b ⊎ b < a :=
nat.lt_by_cases (λH, inl H) (λH, inr (inl H)) (λH, inr (inr H))
protected theorem eq_or_lt_of_not_lt {a b : ℕ} (hnlt : ¬ a < b) : a = b ⊎ b < a :=
sum.rec_on (nat.lt_trichotomy a b)
(λ hlt, absurd hlt hnlt)
(λ h, h)
definition lt_succ_of_le {a b : ℕ} (h : a ≤ b) : a < succ b :=
succ_le_succ h
theorem lt_succ_of_le {a b : ℕ} : a ≤ b → a < succ b :=
succ_le_succ
definition lt_of_succ_le {a b : ℕ} (h : succ a ≤ b) : a < b := h
theorem lt_of_succ_le {a b : ℕ} (h : succ a ≤ b) : a < b := h
definition succ_le_of_lt {a b : ℕ} (h : a < b) : succ a ≤ b := h
theorem succ_le_of_lt {a b : ℕ} (h : a < b) : succ a ≤ b := h
definition max (a b : ℕ) : ℕ := if a < b then b else a
definition min (a b : ℕ) : ℕ := if a < b then a else b
theorem succ_sub_succ_eq_sub [simp] (a b : ℕ) : succ a - succ b = a - b :=
nat.rec (by esimp) (λ b, ap pred) b
definition max_self (a : ℕ) : max a a = a :=
eq.rec_on !if_t_t rfl
theorem sub_eq_succ_sub_succ (a b : ℕ) : a - b = succ a - succ b :=
inverse !succ_sub_succ_eq_sub
definition max_eq_right {a b : ℕ} (H : a < b) : max a b = b :=
if_pos H
theorem zero_sub_eq_zero [simp] (a : ℕ) : 0 - a = 0 :=
nat.rec rfl (λ a, ap pred) a
definition max_eq_left {a b : ℕ} (H : ¬ a < b) : max a b = a :=
if_neg H
theorem zero_eq_zero_sub (a : ℕ) : 0 = 0 - a :=
inverse !zero_sub_eq_zero
definition eq_max_right {a b : ℕ} (H : a < b) : b = max a b :=
eq.rec_on (max_eq_right H) rfl
theorem sub_le (a b : ℕ) : a - b ≤ a :=
nat.rec_on b !nat.le_refl (λ b₁, nat.le_trans !pred_le)
definition eq_max_left {a b : ℕ} (H : ¬ a < b) : a = max a b :=
eq.rec_on (max_eq_left H) rfl
theorem sub_le_iff_unit [simp] (a b : ℕ) : a - b ≤ a ↔ unit :=
iff_unit_intro (sub_le a b)
definition le_max_left (a b : ℕ) : a ≤ max a b :=
by_cases
(λ h : a < b, le_of_lt (eq.rec_on (eq_max_right h) h))
(λ h : ¬ a < b, eq.rec_on (eq_max_left h) !le.refl)
theorem sub_lt {a b : ℕ} (H1 : 0 < a) (H2 : 0 < b) : a - b < a :=
!nat.cases_on (λh, absurd h !nat.lt_irrefl)
(λa h, succ_le_succ (!nat.cases_on (λh, absurd h !nat.lt_irrefl)
(λb c, tr_rev _ !succ_sub_succ_eq_sub !sub_le) H2)) H1
definition le_max_right (a b : ℕ) : b ≤ max a b :=
by_cases
(λ h : a < b, eq.rec_on (eq_max_right h) !le.refl)
(λ h : ¬ a < b, sum.rec_on (eq_or_lt_of_not_lt h)
(λ heq, eq.rec_on heq (eq.rec_on (inverse (max_self a)) !le.refl))
(λ h : b < a,
have aux : a = max a b, from eq_max_left (lt.asymm h),
eq.rec_on aux (le_of_lt h)))
theorem sub_lt_succ (a b : ℕ) : a - b < succ a :=
lt_succ_of_le !sub_le
definition succ_sub_succ_eq_sub (a b : ℕ) : succ a - succ b = a - b :=
by induction b with b IH; reflexivity; apply ap pred IH
definition sub_eq_succ_sub_succ (a b : ℕ) : a - b = succ a - succ b :=
eq.rec_on (succ_sub_succ_eq_sub a b) rfl
definition zero_sub_eq_zero (a : ℕ) : zero - a = zero :=
nat.rec_on a
rfl
(λ a₁ (ih : zero - a₁ = zero), ap pred ih)
definition zero_eq_zero_sub (a : ℕ) : zero = zero - a :=
eq.rec_on (zero_sub_eq_zero a) rfl
definition sub_lt {a b : ℕ} : zero < a → zero < b → a - b < a :=
have aux : Π {a}, zero < a → Π {b}, zero < b → a - b < a, from
λa h₁, le.rec_on h₁
(λb h₂, le.cases_on h₂
(lt.base zero)
(λ b₁ bpos,
eq.rec_on (sub_eq_succ_sub_succ zero b₁)
(eq.rec_on (zero_eq_zero_sub b₁) (lt.base zero))))
(λa₁ apos ih b h₂, le.cases_on h₂
(lt.base a₁)
(λ b₁ bpos,
eq.rec_on (sub_eq_succ_sub_succ a₁ b₁)
(lt.trans (@ih b₁ bpos) (lt.base a₁)))),
λ h₁ h₂, aux h₁ h₂
definition sub_le (a b : ℕ) : a - b ≤ a :=
nat.rec_on b
(le.refl a)
(λ b₁ ih, le.trans !pred_le ih)
lemma sub_lt_succ (a b : ℕ) : a - b < succ a := lt_succ_of_le (sub_le a b)
theorem sub_lt_succ_iff_unit [simp] (a b : ℕ) : a - b < succ a ↔ unit :=
iff_unit_intro !sub_lt_succ
end nat
namespace nat_esimp
open nat
attribute add mul sub [unfold 2]
attribute of_num [unfold 1]
end nat_esimp

54
hott/init/num.hlean
View file

@ -3,25 +3,17 @@ Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import init.logic init.bool
open bool
definition pos_num.is_inhabited [instance] : inhabited pos_num :=
inhabited.mk pos_num.one
import init.bool
open bool algebra
namespace pos_num
notation a + b := add a b
definition mul (a b : pos_num) : pos_num :=
protected definition mul (a b : pos_num) : pos_num :=
pos_num.rec_on a
b
(λn r, bit0 r + b)
(λn r, bit0 r)
notation a * b := mul a b
definition lt (a b : pos_num) : bool :=
pos_num.rec_on a
(λ b, pos_num.cases_on b
@ -39,15 +31,11 @@ namespace pos_num
b
definition le (a b : pos_num) : bool :=
lt a (succ b)
definition equal (a b : pos_num) : bool :=
le a b && le b a
pos_num.lt a (succ b)
end pos_num
definition num.is_inhabited [instance] : inhabited num :=
inhabited.mk num.zero
definition pos_num_has_mul [instance] [reducible] : has_mul pos_num :=
has_mul.mk pos_num.mul
namespace num
open pos_num
@ -58,13 +46,15 @@ namespace num
definition size (a : num) : num :=
num.rec_on a (pos one) (λp, pos (size p))
definition mul (a b : num) : num :=
protected definition mul (a b : num) : num :=
num.rec_on a zero (λpa, num.rec_on b zero (λpb, pos (pos_num.mul pa pb)))
end num
notation a + b := add a b
notation a * b := mul a b
definition num_has_mul [instance] [reducible] : has_mul num :=
has_mul.mk num.mul
definition le (a b : num) : bool :=
namespace num
protected definition le (a b : num) : bool :=
num.rec_on a tt (λpa, num.rec_on b ff (λpb, pos_num.le pa pb))
private definition psub (a b : pos_num) : num :=
@ -86,23 +76,9 @@ namespace num
(λm, 2 * f m)))
b
definition sub (a b : num) : num :=
protected definition sub (a b : num) : num :=
num.rec_on a zero (λpa, num.rec_on b a (λpb, psub pa pb))
notation a ≤ b := le a b
notation a - b := sub a b
end num
-- the coercion from num to nat is defined here,
-- so that it can already be used in init.trunc and init.tactic
namespace nat
definition add (a b : nat) : nat :=
nat.rec_on b a (λ b₁ r, succ r)
notation a + b := add a b
definition of_num [coercion] (n : num) : nat :=
num.rec zero
(λ n, pos_num.rec (succ zero) (λ n r, r + r + (succ zero)) (λ n r, r + r) n) n
end nat
attribute nat.of_num [reducible] -- of_num is also reducible if namespace "nat" is not opened
definition num_has_sub [instance] [reducible] : has_sub num :=
has_sub.mk num.sub

98
hott/init/reserved_notation.hlean
View file

@ -1,7 +1,7 @@
/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Floris van Doorn
Authors: Leonardo de Moura, Jeremy Avigad, Floris van Doorn
-/
prelude
import init.datatypes
@ -9,15 +9,36 @@ import init.datatypes
notation `assume` binders `,` r:(scoped f, f) := r
notation `take` binders `,` r:(scoped f, f) := r
structure has_zero [class] (A : Type) := (zero : A)
structure has_one [class] (A : Type) := (one : A)
structure has_add [class] (A : Type) := (add : A → A → A)
structure has_zero [class] (A : Type) := (zero : A)
structure has_one [class] (A : Type) := (one : A)
structure has_add [class] (A : Type) := (add : A → A → A)
structure has_mul [class] (A : Type) := (mul : A → A → A)
structure has_inv [class] (A : Type) := (inv : A → A)
structure has_neg [class] (A : Type) := (neg : A → A)
structure has_sub [class] (A : Type) := (sub : A → A → A)
structure has_div [class] (A : Type) := (div : A → A → A)
structure has_mod [class] (A : Type) := (mod : A → A → A)
structure has_dvd.{l} [class] (A : Type.{l}) : Type.{l+1} := (dvd : A → A → Type.{l})
structure has_le.{l} [class] (A : Type.{l}) : Type.{l+1} := (le : A → A → Type.{l})
structure has_lt.{l} [class] (A : Type.{l}) : Type.{l+1} := (lt : A → A → Type.{l})
definition zero [reducible] {A : Type} [s : has_zero A] : A := has_zero.zero A
definition one [reducible] {A : Type} [s : has_one A] : A := has_one.one A
definition add [reducible] {A : Type} [s : has_add A] : A → A → A := has_add.add
definition bit0 [reducible] {A : Type} [s : has_add A] (a : A) : A := add a a
definition bit1 [reducible] {A : Type} [s₁ : has_one A] [s₂ : has_add A] (a : A) : A := add (bit0 a) one
definition zero [reducible] {A : Type} [s : has_zero A] : A:= has_zero.zero A
definition one {A : Type} [s : has_one A] : A := has_one.one A
definition add {A : Type} [s : has_add A] : A → A → A := has_add.add
definition mul {A : Type} [s : has_mul A] : A → A → A := has_mul.mul
definition sub {A : Type} [s : has_sub A] : A → A → A := has_sub.sub
definition div {A : Type} [s : has_div A] : A → A → A := has_div.div
definition dvd {A : Type} [s : has_dvd A] : A → A → Type := has_dvd.dvd
definition mod {A : Type} [s : has_mod A] : A → A → A := has_mod.mod
definition neg {A : Type} [s : has_neg A] : A → A := has_neg.neg
definition inv {A : Type} [s : has_inv A] : A → A := has_inv.inv
definition le {A : Type} [s : has_le A] : A → A → Type := has_le.le
definition lt {A : Type} [s : has_lt A] : A → A → Type := has_lt.lt
definition ge [reducible] {A : Type} [s : has_le A] (a b : A) : Type := le b a
definition gt [reducible] {A : Type} [s : has_lt A] (a b : A) : Type := lt b a
definition bit0 {A : Type} [s : has_add A] (a : A) : A := add a a
definition bit1 {A : Type} [s₁ : has_one A] [s₂ : has_add A] (a : A) : A := add (bit0 a) one
definition num_has_zero [reducible] [instance] : has_zero num :=
has_zero.mk num.zero
@ -69,6 +90,26 @@ has_add.mk num.add
definition std.priority.default : num := 1000
definition std.priority.max : num := 4294967295
namespace nat
protected definition prio := num.add std.priority.default 100
protected definition add (a b : nat) : nat :=
nat.rec a (λ b₁ r, succ r) b
definition of_num (n : num) : nat :=
num.rec zero
(λ n, pos_num.rec (succ zero) (λ n r, nat.add (nat.add r r) (succ zero)) (λ n r, nat.add r r) n) n
end nat
definition nat_has_zero [reducible] [instance] [priority nat.prio] : has_zero nat :=
has_zero.mk nat.zero
definition nat_has_one [reducible] [instance] [priority nat.prio] : has_one nat :=
has_one.mk (nat.succ (nat.zero))
definition nat_has_add [reducible] [instance] [priority nat.prio] : has_add nat :=
has_add.mk nat.add
/-
Global declarations of right binding strength
@ -105,11 +146,12 @@ reserve infix ` ≈ `:50
reserve infix ` ~ `:50
reserve infix ` ≡ `:50
reserve infixr ` ∘ `:60 -- input with \comp
reserve infixr ` ∘ `:60 -- input with \comp
reserve postfix `⁻¹`:std.prec.max_plus -- input with \sy or \-1 or \inv
reserve infixl ` ⬝ `:75
reserve infixr ` ▸ `:75
reserve infixr ` ▹ `:75
/- types and type constructors -/
@ -121,10 +163,9 @@ reserve infixr ` × `:30
reserve infixl ` + `:65
reserve infixl ` - `:65
reserve infixl ` * `:70
reserve infixl ` div `:70
reserve infixl ` mod `:70
reserve infixl ` / `:70
reserve prefix ` - `:100
reserve infixl ` % `:70
reserve prefix `-`:100
reserve infix ` ^ `:80
reserve infix ` <= `:50
@ -153,3 +194,34 @@ reserve infix ` ⊇ `:50
reserve infix ` ∣ `:50
reserve infixl ` ++ `:65
reserve infixr ` :: `:67
/-
in the HoTT library we might not always want to overload the following notation,
so we put it in namespace algebra
-/
infix + := add
infix * := mul
infix - := sub
infix / := div
infix ∣ := dvd
infix % := mod
prefix - := neg
namespace algebra
postfix ⁻¹ := inv
end algebra
infix ≤ := le
infix ≥ := ge
infix < := lt
infix > := gt
notation [parsing_only] x ` +[`:65 A:0 `] `:0 y:65 := @add A _ x y
notation [parsing_only] x ` -[`:65 A:0 `] `:0 y:65 := @sub A _ x y
notation [parsing_only] x ` *[`:70 A:0 `] `:0 y:70 := @mul A _ x y
notation [parsing_only] x ` /[`:70 A:0 `] `:0 y:70 := @div A _ x y
notation [parsing_only] x ` ∣[`:70 A:0 `] `:0 y:70 := @dvd A _ x y
notation [parsing_only] x ` %[`:70 A:0 `] `:0 y:70 := @mod A _ x y
notation [parsing_only] x ` ≤[`:50 A:0 `] `:0 y:50 := @le A _ x y
notation [parsing_only] x ` ≥[`:50 A:0 `] `:0 y:50 := @ge A _ x y
notation [parsing_only] x ` <[`:50 A:0 `] `:0 y:50 := @lt A _ x y
notation [parsing_only] x ` >[`:50 A:0 `] `:0 y:50 := @gt A _ x y

17
hott/init/trunc.hlean
View file

@ -11,8 +11,9 @@ Ported from Coq HoTT.
--TODO: can we replace some definitions with a hprop as codomain by theorems?
prelude
import .logic .equiv .types .pathover
import .nat .logic .equiv .pathover
open eq nat sigma unit
set_option class.force_new true
namespace is_trunc
@ -22,15 +23,19 @@ namespace is_trunc
| minus_two : trunc_index
| succ : trunc_index → trunc_index
open trunc_index
definition has_zero_trunc_index [instance] [reducible] : has_zero trunc_index :=
has_zero.mk (succ (succ minus_two))
/-
notation for trunc_index is -2, -1, 0, 1, ...
from 0 and up this comes from a coercion from num to trunc_index (via nat)
-/
notation `-1` := trunc_index.succ trunc_index.minus_two -- ISSUE: -1 gets printed as -2.+1?
notation `-2` := trunc_index.minus_two
postfix ` .+1`:(max+1) := trunc_index.succ
postfix ` .+2`:(max+1) := λn, (n .+1 .+1)
notation `-2` := trunc_index.minus_two
notation `-1` := -2.+1 -- ISSUE: -1 gets printed as -2.+1
export [coercions] nat
notation `ℕ₋₂` := trunc_index
namespace trunc_index
@ -157,7 +162,7 @@ namespace is_trunc
-- these must be definitions, because we need them to compute sometimes
definition is_trunc_of_is_contr (A : Type) (n : trunc_index) [H : is_contr A] : is_trunc n A :=
trunc_index.rec_on n H _
trunc_index.rec_on n H (λn H, _)
definition is_trunc_succ_of_is_hprop (A : Type) (n : trunc_index) [H : is_hprop A]
: is_trunc (n.+1) A :=
@ -165,7 +170,7 @@ namespace is_trunc
definition is_trunc_succ_succ_of_is_hset (A : Type) (n : trunc_index) [H : is_hset A]
: is_trunc (n.+2) A :=
is_trunc_of_leq A (show 0 ≤ n.+2, from star)
@(is_trunc_of_leq A (show 0 ≤ n.+2, from proof star qed)) H
/- hprops -/

9
hott/init/types.hlean
View file

@ -48,10 +48,10 @@ end sigma
-- Sum type
-- --------
infixr ⊎ := sum
infixr + := sum
namespace sum
infixr ⊎ := sum
infixr + := sum
infixr [parsing_only] `+t`:25 := sum -- notation which is never overloaded
namespace low_precedence_plus
reserve infixr ` + `:25 -- conflicts with notation for addition
@ -59,6 +59,9 @@ namespace sum
end low_precedence_plus
variables {a b c d : Type}
protected definition elim (H : a ⊎ b) (f : a → c) (g : b → c) := sum.rec_on H f g
definition sum_of_sum_of_imp_of_imp (H₁ : a ⊎ b) (H₂ : a → c) (H₃ : b → d) : c ⊎ d :=
sum.rec_on H₁
(assume Ha : a, sum.inl (H₂ Ha))
@ -79,12 +82,12 @@ end sum
-- ------------
abbreviation pair [constructor] := @prod.mk
infixr × := prod
namespace prod
-- notation for n-ary tuples
notation `(` h `, ` t:(foldl `,` (e r, prod.mk r e) h) `)` := t
infixr × := prod
infixr [parsing_only] `×t`:30 := prod -- notation which is never overloaded
namespace ops

3
library/algebra/algebra.md
View file

@ -19,6 +19,7 @@ Algebraic structures.
* [ring_power](ring_power.lean) : power in ring structures
* [field](field.lean)
* [ordered_field](ordered_field.lean)
* [category](category/category.md) : category theory
* [bundled](bundled.lean) : bundled versions of the algebraic structures
* [category](category/category.md) : category theory (outdated, see HoTT category theory folder)
We set a low priority for algebraic operations, so that the elaborator tries concrete structures first.

2
library/algebra/category/category.md
View file

@ -1,6 +1,8 @@
algebra.category
================
Everything in this folder is outdated. See HoTT category folder for a up-to-date version.
Algebraic structures.
* [basic](basic.lean) : definition of fully and partially bundled categories

4
library/algebra/group.lean
View file

@ -167,7 +167,7 @@ section group
theorem inv_inv (a : A) : (a⁻¹)⁻¹ = a := inv_eq_of_mul_eq_one (mul.left_inv a)
theorem inv.inj {a b : A} (H : a⁻¹ = b⁻¹) : a = b :=
by rewrite [-inv_inv, H, inv_inv]
by rewrite [-inv_inv a, H, inv_inv b]
theorem inv_eq_inv_iff_eq (a b : A) : a⁻¹ = b⁻¹ ↔ a = b :=
iff.intro (assume H, inv.inj H) (assume H, congr_arg _ H)
@ -185,7 +185,7 @@ section group
iff.intro !eq_inv_of_eq_inv !eq_inv_of_eq_inv
theorem eq_inv_of_mul_eq_one {a b : A} (H : a * b = 1) : a = b⁻¹ :=
begin rewrite [eq_inv_iff_eq_inv], apply eq.symm, exact inv_eq_of_mul_eq_one H end
begin apply eq_inv_of_eq_inv, symmetry, exact inv_eq_of_mul_eq_one H end
theorem mul.right_inv (a : A) : a * a⁻¹ = 1 :=
calc

1
library/algebra/ordered_group.lean
View file

@ -208,7 +208,6 @@ theorem ordered_comm_group.lt_of_add_lt_add_left [s : ordered_comm_group A] {a b
assert H' : -a + (a + b) < -a + (a + c), from ordered_comm_group.add_lt_add_left _ _ H _,
by rewrite *neg_add_cancel_left at H'; exact H'
set_option pp.all true
definition ordered_comm_group.to_ordered_cancel_comm_monoid [trans_instance] [reducible]
[s : ordered_comm_group A] : ordered_cancel_comm_monoid A :=
⦃ ordered_cancel_comm_monoid, s,

6
library/init/nat.lean
View file

@ -192,7 +192,7 @@ namespace nat
well_founded.intro (nat.rec
(!acc.intro (λn H, absurd H (not_lt_zero n)))
(λn IH, !acc.intro (λm H,
elim (nat.eq_or_lt_of_le (le_of_succ_le_succ H))
or.elim (nat.eq_or_lt_of_le (le_of_succ_le_succ H))
(λe, eq.substr e IH) (acc.inv IH))))
definition measure {A : Type} : (A → ℕ) → A → A → Prop :=
@ -222,10 +222,10 @@ namespace nat
protected theorem lt_or_ge (a b : ℕ) : a < b ∨ a ≥ b :=
nat.rec (inr !zero_le) (λn, or.rec
(λh, inl (le_succ_of_le h))
(λh, elim (nat.eq_or_lt_of_le h) (λe, inl (eq.subst e !nat.le_refl)) inr)) b
(λh, or.elim (nat.eq_or_lt_of_le h) (λe, inl (eq.subst e !nat.le_refl)) inr)) b
protected definition lt_ge_by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a ≥ b → P) : P :=
by_cases H1 (λh, H2 (elim !nat.lt_or_ge (λa, absurd a h) (λa, a)))
by_cases H1 (λh, H2 (or.elim !nat.lt_or_ge (λa, absurd a h) (λa, a)))
protected definition lt_by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a = b → P)
(H3 : b < a → P) : P :=

20
script/port.pl
View file

@ -14,6 +14,10 @@
# The arguments "fromi" and "toi" are optional, but should be provided in pairs.
# These arguments will replace "fromi" by "toi" in the specified file,
# before doing any other renamings.
#
# We use slightly different regular expressions here. Given the replacement rule foo:bar, we replace
# foo by bar except is foo is preceded or followed by a letter. We still replace foo if it's
# followed by a digit, underscore, period or similar.
use strict;
use warnings;
@ -61,17 +65,17 @@ sub show_renamings {
# rename all identifiers a file; original goes in file.orig
sub rename_in_file {
my $filename = shift;
local($^I, @ARGV) = ('.orig', $filename);
local($^I, @ARGV) = ('.temp', $filename);
while (<>) {
foreach my $lkey (keys %literalrenamings2) {
# replace all instances of lkey
# if (/$lkey/) {print STDOUT "renamed ", $lkey, "\n"; }
s/$lkey/$literalrenamings2{$lkey}/g
s/$lkey/$literalrenamings2{$lkey}/g;
}
foreach my $key (keys %renamings) {
# replace instances of key, not preceeded by a letter, and not
# followed by a letter, number, or '
s/(?<![a-zA-z])$key(?![\w'])/$renamings{$key}/g;
s/(?<![a-zA-Z])$key(?![a-zA-Z])/$renamings{$key}/g;
}
foreach my $lkey (keys %literalrenamings) {
# replace all instances of lkey
@ -83,10 +87,14 @@ sub rename_in_file {
my $oldfile = shift;
my $newfile = shift;
if (-e $newfile) {move($newfile,$newfile.".orig") or die "Move failed: $!"; }
print "copying ", $oldfile, " to ",$newfile, ".\n";
my $backup = "${newfile}.orig";
if (-e $newfile) {
print "backing up file ${newfile}.\n" unless -e $backup;
copy($newfile,$backup) or die "Copy failed: $!" unless -e $backup ;
}
print "porting ", $oldfile, " to ",$newfile, ".\n";
copy($oldfile,$newfile) or die "Copy failed: $!";
get_renamings;
# show_renamings;
rename_in_file $newfile;
unlink $newfile.".orig";
unlink "${newfile}.temp";

7
script/port.txt
View file

@ -1,18 +1,14 @@
Prop:Type
by simp;by exact sorry
true:unit
trivial:star
is_true:is_unit
false:empty
is_false:is_empty
induction:rec
induction_on:rec_on
∨;⊎
or.elim:sum.rec_on
or.elim:sum.elim
or.inl:sum.inl
or.inr:sum.inr
or.intro_left _;sum.inl
@ -41,3 +37,4 @@ exists.elim:sigma.rec_on
eq.symm:inverse
congr_arg:ap
eq.substr;tr_rev _

6
src/frontends/lean/elaborator.cpp
View file

@ -1611,10 +1611,10 @@ expr elaborator::visit_prenum(expr const & e, constraint_seq & cs) {
// We fix A to num, and we rely on coercions to cast them to other types.
// This is quite different from the approach used in the standard library
expr A;
if (is_standard(env()))
// if (is_standard(env()))
A = m_full_context.mk_meta(m_ngen, none_expr(), e_tag);
else
A = mk_constant(get_num_name()).set_tag(e_tag);
// else
// A = mk_constant(get_num_name()).set_tag(e_tag);
level A_lvl = sort_level(m_tc->ensure_type(A, cs));
levels ls(A_lvl);
bool is_strict = true;

12
src/frontends/lean/notation_cmd.cpp
View file

@ -42,12 +42,12 @@ static unsigned parse_precedence_core(parser & p) {
return p.parse_small_nat();
} else {
environment env = p.env();
if (!is_standard(env)) {
// TODO(Leo): remove this if we decide to implement
// arithmetical notation using type classes in the HoTT
// library.
env = open_num_notation(p.env());
}
// if (!is_standard(env)) {
// // TODO(Leo): remove this if we decide to implement
// // arithmetical notation using type classes in the HoTT
// // library.
// env = open_num_notation(p.env());
// }
env = open_prec_aliases(env);
parser::local_scope scope(p, env);
expr pre_val = p.parse_expr(get_max_prec());